Самоучитель VBA


Рисунок У13 2 Заполнение диалогового окна



Рисунок У13.2. Заполнение диалогового окна




Магазин Придорожный лопух, 24 часа

  1. Ввод имени дежурного в смену производится перемещением указателя на надпись соответствующей смены и щелчком кнопкой мыши. Программа автоматически вставляет имя дежурного в надпись смены (Рисунок У13.2).
  2. Удалить имя дежурного из смены можно, указав на пустую надпись в группе компаньон и выполнив щелчок, а затем переместив указатель на надпись смены, из которой требуется удалить имя дежурного, и также щелкнув кнопкой мыши.
  3. Подсчет числа рабочих смен каждого из компаньонов производится нажатием на кнопку ок.

Обсудим, как приведенная ниже программа решает описанную задачу и что в ней происходит.

UserForm Initialize

  1. Активизирует диалоговое окно.
  2. Очищает все надписи и задает свойства элементов управления Image .
  3. Устанавливает тип границы и цвет фона надписей.

Нажатие кнопки ок запускает на выполнение процедуру

CommandButtonl Click

Производит расчет числа рабочих смен компаньонов.

Нажатие кнопки Отмена запускает на выполнение процедуру

CommandButton2 Click

Закрывает диалоговое окно.

От Labell Click до Label4_Click

Считывает имя кандидата в дежурные при выборе соответствующей надписи из группы компаньоны. Сигнализирует об этом отображением красного круга рядом с именем выбранного кандидата.

От Labels Click до Label18 Click

Вводит имя кандидата в дежурные в надпись соответствующей смены.


' Переменные уровня модуля

Dim Имя As String

Dim Надписи(1 То 2, 1 То 7) As Object

Private Sub CommandButtonl_Click()

Dim Смены_1, Смены_2, Смены_3 As Integer

Смены_1 = 0

Смены_2 = 0

Смены_3 = 0

For i = 1 То 2

For j = 1 То 7

If Надписи(i, j).Caption = Label1.Caption Then Смены_1 = Смены_1 + 1

If Надписи(i, j).Caption = Label2.Caption Then Смены_2 = Смены_2 + 1

If Надписи(i, j).Caption = Label3.Caption Then Смены_3 = Смены_3 + 1

Next j

Next i

TextBoxl.Text = CStr(Смены_1)

TextBox2.Text = CStr(Смены_2)

TextBoxS.Text = CStr(Смены_3)

End Sub

'

Private Sub CommandButton2_Click()

UserForml.Hide End Sub

' Процедуры считывания имени дежурного из группы Компаньоны

'

Private Sub Labell_Click ()

Имя = Label1.Caption Действие True, False, False

End Sub

'

Private Sub Label2_Click() Имя = Label2.Caption Действие False, True, False

End Sub

'

Private Sub Label3_Click()

Имя = Labels.Caption

Действие False, False, True

End Sub

'

Private Sub Label4_Click()

Имя = Label4.Caption Действие False, False, False

End Sub

'

' Процедуры ввода имени дежурного

'

Private Sub Label5_Click() Labels.Caption = Имя

End Sub

'

Private Sub Label6_Click0 Label6.Caption = Имя

End Sub

Private Sub Label7_Click() Label7.Caption = Имя

End Sub

Private Sub Label8_Click() Labels.Caption = Имя

End Sub

Private Sub Label9_Click() Label9.Caption = Имя

End Sub

Private Sub Labell0_Click() Labell0.Caption = Имя

End Sub

Private Sub Labelll_Click() Labelll.Caption = Имя

End Sub '

Private Sub Labell2_Click() Labell2.Caption = Имя

End Sub '

Private Sub Labell3__Click ()

Labell3.Caption = Имя

End Sub

'

Private Sub Labell4_Click() Labell4.Caption = Имя

End Sub

'

Private Sub Labell5_Click() Label15.Caption = Имя

End Sub

'

Private Sub Labell6_Click() Labell6.Caption = Имя

End Sub

'

Private Sub Labell7_Click() Labell7 .Caption = Имя

End Sub

Private Sub Labell8_Click() LabellS.Caption = Имя

End Sub

'

Private Sub UserForm_Initialize()

'

' Инициализация диалогового окна

Dim i, j As Integer

Set Надписи(1, 1) = Label5

Set Надписи(2, 1} = Label6

Set Надписи(1, 2) = Label7

Set Надписи(2, 2) = Label8

Set Надписи(1, 3) = Label9

Set Надписи(2, 3) = Labell0

Set Надписи(1, 4) = Label11

Set Надписи(2, 4) = Labell2

Set Надписи(1, 5) = Label13

Set Надписи(2, 5) = Label14

Set Надписи(1, 6) = Labell5

Set Надписи(2, 6) = Labell6

Set Надписи(1, 7) = Labell7

Set Надписи(2, 7) = Label18

'

With Label4

.Caption = ""

.BorderStyle = fmBorderStyleSingle

End With

With Imagel

.Picture = LoadPicture("ball.bmp")

.BorderStyle = fmBorderStyleNone

.PictureSizeMode = fmPictureSizeModeZoom

.PictureAlignment = fmPictureAlignmentTopLeft

.Visible = False

End With

'

With Image2

.Picture = LoadPicture("ball.bmp")

.BorderStyle = fmBorderStyleNone

.PictureSizeMode = fmPictureSizeModeZoom

.PictureAlignment = fmPictureAlignmentTopLeft

.Visible = False

End With

'

With Image3

.Picture = LoadPicture("ball.bmp")

.BorderStyle = fmBorderStyleNone

.PictureSizeMode = fmPictureSizeModeZoom

.PictureAlignment = fmPictureAlignmentTopLeft

.Visible = False

End With

'

For i = 1 To 2 For j = 1 To 7

With Надписи(i, j)

.Caption = ""

.BorderStyle = fmBorderStyleNone Select Case i Case 1

.BackColor = vbWhite Case 2

.BackColor = vbYellow End Select

End With

Next j

Next i

'

End Sub

Sub Действие(Flagl, Flag2, Flag3 As Boolean)

'

' Процедура, устанавливающая отображение или скрытие рисунков

'

Imagel.Visible = Flagl

Image2.Visible = Flag2

Image3.Visible = Flag3

End Sub









Начало  Назад  Вперед