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

Практика



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

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

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

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

  • Перемещением указателя на надпись из группы компаньоны и щелчком кнопкой мыши выбирается компаньон, который будет дежурить Программа информирует пользователя о выборе кандидата в дежурные отображением красного круга рядом с его именем.

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

  • Для более наглядного представления надписи, соответствующие сменам с О до 12 часов, имеют белый цвет фона, а надписи, соответствующие сменам с 12 до 24 часов, — желтый цвет фона.

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

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



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

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

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

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

    UserForm Initialize

    1. Активизирует диалоговое окно.

    2. Очищает все надписи и задает свойства элементов управления Image .

      Устанавливает тип границы и цвет фона надписей.

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

    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




    Содержание раздела