Шаг 211.
VBA в MSExcel. Практические приемы программирования на VBA. Тема: еще раз о составлении базы данных. Практика (модуль Модуль1)

    На этом шаге мы перечислим процедуры этого модуля.

    На 209 шаге при описании модуля Модуль1 были указаны переменные уровня проекта, теперь рассмотрим несколько его процедур.

Модуль Модуль1
  • Процедура UserForm1_Initialize инициализирует диалоговое окно Регистрация туристов фирмы "С нами не соскучишься". Также при помощи вызова процедуры ЗаголовокЛиста в ней создаются заголовки полей базы данньгх на рабочем листе, в случае их отсутствия.
  • Процедура UserForm3_Initialize активизирует диалоговое окно Поиск.
  • Процедура UserForm4_Initialize активизирует диалоговое окно Фильтрация.
  • Процедура Сортировка упорядочивает данные по двум критериям: первоначальный критерий направление тура, второстепенный - оплата.
  • Процедура СводнаяТаблица создает рабочий лист Сводная Таблица со сводной таблицей (рисунок 1).


    Рис.1. Рабочий лист СводнаяТаблица

        Столбцы сводной таблицы основаны на поле Оплачено; строки - на поле Направление тура, а результаты сводной таблицы подводятся суммированием по полю Продолжительность базы данных. На основе сводной таблицы строится диаграмма. При этом используется свойство TableRange1 объекта PivotTable, возвращающее диапазон с данными сводной таблицы, что позволяет избежать необходимости явного описания диапазона, по которому строится диаграмма.

  • Процедура СохранитьКак активизирует встроенное диалоговое окно Сохранение документа.
  • Процедура Закрыть закрывает приложение.

    Приведем его текст.

Public Sub UserForm1_Initialize()
  ' Процедура активизации диалогового окна Регистрация туристов
  ' и задание элементов раскрывающегося списка

  ' Проверка наличия заголовка базы данных.
  ' Построение заголовка базы данных в случае его отсутствия
  If Sheets("БазаДанных").Range("A1").Value <> "Фамилия" Then
    ЗаголовокЛиста
  End If
  
  ' Задание элементов раскрывающегося списка
  With UserForm1
    .CommandButton1.Default = True
    .CommandButton2.Cancel = True
    .ComboBox1.List = Array("Афины", "Берлин", "Лондон")
    .ComboBox1.ListIndex = 0
    .OptionButton1.Value = True
    .SpinButton1.Value = 1
    .CheckBox1.Value = False
    .CheckBox2.Value = False
    .CheckBox3.Value = False
  End With

  ' Активизация диалогового окна
  UserForm1.Show
End Sub

Public Sub ЗаголовокЛиста()
  With Sheets("БазаДанных")
    .Range("A1").Value = "Фамилия"
    .Range("B1").Value = "Имя"
    .Range("C1").Value = "Пол"
    .Range("D1").Value = "Направление тура"
    .Range("E1").Value = "Оплачено"
    .Range("F1").Value = "Фото сданы"
    .Range("G1").Value = "Паспорт сдан"
    .Range("H1").Value = "Продолжительность"
    .Range("A:A").ColumnWidth = 9.43
    .Range("B:C").ColumnWidth = 8.43
    .Range("D:D").ColumnWidth = 13.43
    .Range("E:E").ColumnWidth = 10.14
    .Range("F:F").ColumnWidth = 9
    .Range("G:G").ColumnWidth = 8.43
    .Range("H:H").ColumnWidth = 19.14
  End With

  Sheets("БазаДанных").Rows("1:1").Select
  With Selection
    .Font.Bold = True
    .HorizontalAlignment = xlGeneral
    .VerticalAlignment = xlTop
    .WrapText = True
    With .Interior
      .ColorIndex = 36
      .Pattern = xlSolid
    End With
  End With
  Sheets("БазаДанных").Rows("2:2").Select
  ActiveWindow.FreezePanes = True
End Sub

Public Sub Запись()
  ActiveWorkbook.Save
End Sub

Private Sub UserForm3_Initialize()
  ' Процедура активизации диалогового окна Поиск
  UserForm3.Show
End Sub

Private Sub Автофильтр()
  ' Процедура вызова команды Автофильтр
  Sheets("БазаДанных").Range("A1:H1").Select
  Selection.AutoFilter
End Sub

Private Sub UserForm4_Initialize()
  ' Процедура активизации диалогового окна фильтрации
  With UserForm4
    .OptionButton1.Value = True
    .Show
  End With
End Sub

Private Sub Сортировка()
  ' Процедура сортировки данных
  ' Первоначальный критерий сортировки - направление тура,
  ' второстепенный - произведение оплаты

  Dim n As Integer
  ' n - вспомогательная переменная
  Sheets("БазаДанных").Range("A2").Select
  n = Selection.CurrentRegion.Rows.Count    '

  ' Определение числа записей в базе данных
  Worksheets("БазаДанных").Range(Cells(2, 1), Cells(n + 1, 8)).Sort _
    key1:=Worksheets("БазаДанных").Range("D2"), _
    order1:=xlAscending, _
    key2:=Worksheets("БазаДанных").Range("E2"), _
    order2:=xlDescending

  ' Сортировка по турам в возрастающем,
  ' а по оплате - в убывающем порядке
End Sub

Private Sub СводнаяТаблица()
  ' Процедура построения сводной таблицы
  Dim n As Integer
  Dim i As Integer
  Dim Списки, Назначение As String
  Dim Лист As Object
  Dim ИмяКниги As String
  ИмяКниги = ActiveWorkbook.Name

  ' Исключаем расширение из имени книги
  For i = 1 To Len(ИмяКниги)
    If Mid(ИмяКниги, i, 1) = "." Then
      ИмяКниги = Mid(ИмяКниги, 1, i - 1)
      Exit For
    End If
  Next i
  ИмяКниги = Trim(ИмяКниги)
  
  ' Удаляются ранее созданные рабочие листы с именем СводнаяТаблица
  For Each Лист In Worksheets
    If Лист.Name = "СводнаяТаблица" Then
      Sheets("СводнаяТаблица").Delete
    End If
  Next Лист

  ' Создается новый рабочий лист с именем СводнаяТаблица
  Worksheets.Add
  ActiveSheet.Name = "СводнаяТаблица"
  n = Worksheets("БазаДанных").Range("A2").CurrentRegion.Rows.Count

  ' Определение диапазона, по которому будет строиться
  ' сводная таблица (Списки) и где она будет расположена (Назначение).
  ' Эти диапазоны записываются в виде строковых выражений
  Списки = "БазаДанных!R1C1:R" & CStr(n) & "C8"
  Назначение = "[" & ИмяКниги & "]СводнаяТаблица!R1C1"

  ' Создание сводной таблицы
  ActiveSheet.PivotTableWizard SourceType:=xlDatabase, _
    SourceData:=Списки, TableDestination:=Назначение, TableName:="Отчет"

  ActiveSheet.PivotTables("Отчет").AddFields _
    RowFields:="Направление тура", ColumnFields:="Оплачено"
  With ActiveSheet.PivotTables("Отчет").PivotFields("Продолжительность")
    .Orientation = xlDataField
    .Name = "Сумма по полю Продолжительность"
    .Function = xlSum
  End With

  ' Построение диаграммы по сводной таблице
  Dim СводнаяТаблица As PivotTable
  Dim Диапазон As Range
  Set СводнаяТаблица = ActiveSheet.PivotTables("Отчет")
  With ActiveSheet.PivotTables("Отчет")
    ' He отображаются итоги по строкам и столбцам
    .RowGrand = False
    .ColumnGrand = False
  End With

  ' Определение диапазона из сводной таблицы,
  ' по которому строится диаграмма
  Set Диапазон = ActiveSheet.PivotTables("Отчет").TableRange1

  ' Построение диаграммы
  Charts.Add
  ActiveChart.ChartType = xlColumnClustered
  ActiveChart.SetSourceData Source:=Диапазон, PlotBy:=xlColumns
  ActiveChart.Location Where:=xlLocationAsObject, Name:="СводнаяТаблица"
  With ActiveChart
    .HasTitle = False
    .Axes(xlCategory, xlPrimary).HasTitle = False
    .Axes(xlValue, xlPrimary).HasTitle = True
    .Axes(xlValue, xlPrimary).AxisTitle.Characters.Text = _
      "Продолжительность оплаченных/неоплаченных поездок"
  End With
End Sub

Sub СохранитьКак()
  ' Процедура активизирует встроенное окно Сохранение документа
  Application.Dialogs(xlDialogSaveAs).Show
End Sub

Sub Закрыть()
  ' Процедура закрытия приложения
  Application.Quit
End Sub

    На следующем шаге мы рассмотрим модуль UserForm1.




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