Информационно-аналитическая система аптечного управления

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

        
 
 
 
 
 
 
 
 
 

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

         
 

       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