5. Система меню

При активизации рабочей книги выполняется событие Workbook_Open, в процедуре которой открывается лист Меню, содержащая следующие кнопку Меню при нажатии которой выходит форма для перехода:

• Лекарства;

• Справочник;

• Сводная таблица;

• Диаграмма;

• Аптеки;

• Сведения об авторе;

• Кнопка выхода из приложения.

Лист Меню имеет следующий вид:

Также в приложении созданы Фомы для быстрого перехода по нужным ссылкам.

6. Проверка данных

При ручном вводе в столбцах стоит проверка данных с помощью стандартных средств MS Excel.

Примерный текст проверки числовых данных:

If Not IsNumeric(TextBox4.Text) Then

Msg = MsgBox("Вводить надо числовые данные ", vbCritical)

Exit Sub

End If

Список использованной литературы

1. Информатика: «Microsoft Excel и VBA». Учебное пособие к выполнению курсовой работы. /Составители: Каляшина А.В., Бусова А.М. – Набережные Челны: Издательство Инека, 2008.

2. Питер Эйткен. Интенсивный курс программирования в Excel за выходные. : Пер. с англ. — М.: Издательский дом "Вильяме", 2004. — 432 с.: ил. — Парал. тит. англ.

3. К. Гетц, Д. Джилберт. Программирование в MS Office – 2004 .

Приложение

Удаление данных

Dim pr As Object, X As Object

Dim name As String

Dim h As Byte

Dim Y As Byte

h = MsgBox("Вы действительно хотите удалить этот товар?", vbYesNo + vbQuestion, "Удаление")

If h = vbYes Then Else GoTo e

name = ComboBox1

If ComboBox1 = "" Then

Y = MsgBox("Действительно хотите удалить данные", vbYesNo + vbQuestion, "Удаление")

If Y = vbYesNo Then GoTo 12 Else GoTo e

End If

ActiveWorkbook.Sheets("Регистрация поступлений").Activate

Set pr = ActiveSheet.Range("a2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = name Then

pr.Select

Selection.EntireRow.Delete

End If

Set pr = X

Loop

ActiveWorkbook.Sheets("Регистрация поступлений").Activate

Set pr = ActiveSheet.Range("a2")

Do While Not IsEmpty(pr)

Set X = pr.Offset(1, 0)

If pr = name Then

pr.Select

Selection.EntireRow.Delete

End If

Set pr = X

Loop

12 ComboBox1 = ""

UserForm3.Hide

e: End Sub

Очистка полей формы

TextBox1.Text = " "

TextBox2.Text = " "

TextBox3.Text = " "

TextBox4.Text = " "

TextBox4.Text = " "

Сортировка

Range("A1").Select

Selection.Sort key1:=Range("a2"), order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom

UserForm10.Hide

Сводная таблица

Sub Сводная таблица()

Sheets("Сводная таблица").Select

Application.DisplayAlerts = False

ActiveWindow.SelectedSheets.Delete

Application.DisplayAlerts = True

Sheets("Ведомость покупок").Select

ActiveWorkbook.PivotCaches.Add (SourceType:=xlDatabase, SourceData:= "Ведомость покупок!R1C1:R41C5"). CreatePivotTable TableDestination:="", TableName:="Сводная таблица3", DefaultVersion:=xlPivotTableVersion10

ActiveSheet.PivotTableWizard TableDestination:=ActiveSheet.Cells(3, 1)

ActiveSheet.Cells(3, 1).Select

With ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Название игрушки")

.Orientation = xlRowField

.Position = 1

End With

With ActiveSheet.PivotTables("СводнаяТаблица3").PivotFields("Дата продажи")

.Orientation = xlColumnField

.Position = 1

End With

ActiveSheet.PivotTables("СводнаяТаблица3").AddDataField ActiveSheet.PivotTables _

("СводнаяТаблица3").PivotFields("Стоимость"), "Сумма по полю Стоимость", xlSum

ActiveWorkbook.ShowPivotTableFieldList = False

Application.CommandBars("PivotTable").Visible = False

Columns("C:C").EntireColumn.AutoFit

Columns("D:D").EntireColumn.AutoFit

Columns("E:E").EntireColumn.AutoFit

Columns("F:F").EntireColumn.AutoFit

Columns("G:G").EntireColumn.AutoFit

Columns("H:H").EntireColumn.AutoFit

Columns("U:U").EntireColumn.AutoFit

Columns("T:T").EntireColumn.AutoFit

Columns("S:S").EntireColumn.AutoFit

Columns("R:R").EntireColumn.AutoFit

Columns("Q:Q").EntireColumn.AutoFit

Columns("P:P").EntireColumn.AutoFit

Columns("N:N").EntireColumn.AutoFit

Columns("O:O").EntireColumn.AutoFit

Columns("M:M").EntireColumn.AutoFit

Columns("L:L").EntireColumn.AutoFit

Columns("K:K").EntireColumn.AutoFit

Columns("J:J").EntireColumn.AutoFit

Columns("I:I").EntireColumn.AutoFit

Range("B5").Select

Range(Selection, Selection.End(xlDown)).Select

Range("B5:B14").Select

Range(Selection, Selection.End(xlToRight)).Select

Range(Selection, Selection.End(xlToRight)).Select

Range("B5:V14").Select

Selection.NumberFormat = "#,##0.00$"

Range("A1").Select

Sheets(ActiveSheet.name).name = "Сводная таблица"

Sheets("Сводная таблица").Move After:=Sheets(5)

ActiveSheet.Buttons.Add(18.75, 246.75, 101.25, 27.75).Select

ActiveSheet.Shapes(1).Select

Selection.Characters.Text = "Ìåíþ..."

With Selection.Characters(Start:=1, Length:=7).Font

.name = "Arial Cyr"

.FontStyle = "обычный"

.Size = 10

.Strikethrough = False

.Superscript = False

.Subscript = False

.OutlineFont = False

.Shadow = True

.Underline = xlUnderlineStyleNone

.ColorIndex = xlAutomatic

End With

Range("B21").Select

ActiveSheet.Shapes(1).Select

Selection.OnAction = "переход"

Range("A1").Select

End Sub

24