Шаг 222.
VBA в MSExcel. Практические приемы программирования на VBA. Тема: составление расписания. Практика

    На этом шаге мы рассмотрим основные моменты создания указанного приложения.

    Трус, Балбес и Бывалый построили небольшой магазинчик "Придорожный лопух, 24 часа" у деревне Неелово на трассе Москва — Санкт-Петербург. Работу в магазинчике они разбили на две смены по 12 часов. В начале очередной недели они вместе составляют график своего дежурства на неделю, в котором подсчитывается число рабочих смен каждого компаньона. Через месяц они решили автоматизировать процесс создания расписания. С этой целью они разработали приложение, процесс создания которого обсуждается ниже.

    В редакторе форм создадим диалоговое окно Магазин Придорожный лопух, 24 часа (рисунок 1).


Рис.1. Диалоговое окно Магазин Придорожный лопух, 24 часа

    Кроме этого, в любом графическом редакторе, например Paint, создадим файл ball.bmp с изображением красного шара и фоном рисунка того же цвета, что и цвет диалогового окна.

    Расписание составляется очень просто:

  1. Перемещением указателя на надпись из группы Компаньоны и щелчком кнопкой мыши выбирается компаньон, который будет дежурить. Программа информирует пользователя о выборе кандидата в дежурные отображением красного круга рядом с его именем.
  2. Для более наглядного представления надписи, соответствующие сменам с 0 до 12 часов, имеют белый цвет фона, а надписи, соответствующие сменам с 12 до 24 часов, — желтый цвет фона.
  3. Ввод имени дежурного в смену производится перемещением указателя на надпись соответствующей смены и щелчком кнопкой мыши. Программа автоматически вставляет имя дежурного в надпись смены (рисунок 2).


    Рис.2. Заполнение диалогового окна Магазин Придорожный лопух, 24 часа

  4. Удалить имя дежурного из смены можно, указав на пустую надпись в группе компаньон и выполнив щелчок, а затем переместив указатель на надпись смены, из которой требуется удалить имя дежурного, и также щелкнув кнопкой мыши.
  5. Подсчет числа рабочих смен каждого из компаньонов производится нажатием на кнопку OK.

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

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

Нажатие кнопки OK запускает на выполнение процедуру CommandButton1_Click
Производит расчет числа рабочих смен компаньонов.

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

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

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

    Приведем текст приложения.

' Переменные уровня модуля
Dim Имя As String
Dim Надписи(1 To 2, 1 To 7) As Object

Private Sub CommandButton1_Click()
  Dim Смены_1, Смены_2, Смены_3 As Integer
  Смены_1 = 0
  Смены_2 = 0
  Смены_3 = 0
  For i = 1 To 2
    For j = 1 To 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
  TextBox1.Text = CStr(Смены_1)
  TextBox2.Text = CStr(Смены_2)
  TextBox3.Text = CStr(Смены_3)
End Sub

Private Sub CommandButton2_Click()
  UserForm1.Hide
End Sub

' Процедуры считывания имени дежурного из группы Компаньоны
Private Sub Label1_Click()
  Имя = Label1.Caption
  Действие True, False, False
End Sub

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

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

Private Sub Label4_Click()
  Имя = Label4.Caption
  Действие False, False, False
End Sub

' Процедуры ввода имени дежурного
Private Sub Label5_Click()
  Label5.Caption = Имя
 End Sub

Private Sub Label6_Click()
  Label6.Caption = Имя
End Sub

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

Private Sub Label8_Click()
  Label8.Caption = Имя
End Sub

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

Private Sub Label10_Click()
  Label10.Caption = Имя
End Sub

Private Sub Label11_Click()
  Label11.Caption = Имя
End Sub

Private Sub Label12_Click()
  Label12.Caption = Имя
End Sub

Private Sub Label13_Click()
  Label13.Caption = Имя
End Sub

Private Sub Label14_Click()
  Label14.Caption = Имя
End Sub

Private Sub Label15_Click()
  Label15.Caption = Имя
End Sub

Private Sub Label16_Click()
  Label16.Caption = Имя
End Sub

Private Sub Label17_Click()
  Label17.Caption = Имя
End Sub

Private Sub Label18_Click()
  Label18.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) = Label10
  Set Надписи(1, 4) = Label11
  Set Надписи(2, 4) = Label12
  Set Надписи(1, 5) = Label13
  Set Надписи(2, 5) = Label14
  Set Надписи(1, 6) = Label15
  Set Надписи(2, 6) = Label16
  Set Надписи(1, 7) = Label17
  Set Надписи(2, 7) = Label18

  With Label4
    .Caption = ""
    .BorderStyle = fmBorderStyleSingle
  End With
  With Image1
    .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 Действие(Flag1, Flag2, Flag3 As Boolean)
  ' Процедура, устанавливающая отображение или скрытие рисунков
  Image1.Visible = Flag1
  Image2.Visible = Flag2
  Image3.Visible = Flag3
End Sub
Текст этого примера можно взять здесь.

    На следующем шаге мы рассмотрим продолжим разработку приложений.




Предыдущий шаг Содержание Следующий шаг