
- •Пояснительная записка
- •Содержание
- •Введение
- •1. Программная документация
- •1.1. Описание применения
- •1.1.1. Назначение программы
- •1.1.2. Условия применения
- •1.1.3. Описание задачи
- •1.1.4. Входные и выходные данные
- •1.2.4. Сообщения оператору
- •1.3. Руководство программиста
- •1.3.1. Назначение и условия применения программы
- •1.3.2. Характеристика программы
- •1.3.3. Обращения к программе
- •1.3.5. Сообщения
- •1.4. Руководство системного программиста
- •1.4.1. Общие сведения о программе
- •1.4.2. Структура программы
- •1.4.3. Сообщения системному программисту
- •Заключение
- •Библиографический список
- •Приложение а. Листинг наиболее значимых частей программы
1.4.3. Сообщения системному программисту
Во время выполнения программы системному программисту могут выводиться следующие сообщения:
1. Некорректная дата заполнения. Причиной данной ошибки является некорректный ввод месяца в графе «Дата заполнения». Для её устранения, выберите месяц из списка.
2. Введены не все данные. Причиной данной ошибки является нажатие управляющей кнопки «Далее >>», при том, что заполнены не все активные поля. Для её устранения необходимо заполнить эти поля.
3. Выберите удаляемый элемент списка. Причиной данной ошибки является нажатие кнопки «Удалить» панели ввода раздела «Перенесённые и сопутствующие заболевания», при том, что ни один из элементов списка не выделен. Для её устранения выделите необходимый для удаления элемент списка щелчком левой кнопки мыши и повторите попытку.
Заключение
Была спроектирована система, производящая сбор данных об ортодонтическом пациенте, внесение этих данных в базу данных Excel, а также печать отчёта по данным по заданному образцу (карта оротодонтического пациента). Программа была создана в среде Visual Basic for Application.
Программа прошла тщательную проверку на различных входных данных. В результате проверки работы программы ошибок выявлено не было, что свидетельствует о правильной реализации алгоритма.
Библиографический список
1. Демидова Л.А., Пылькин А.Н. Программирование в среде Visual Basic for Applications. – М.: Горячая линия-Телеком, 2004. – 175 c.
2. Дж. Уокенбах Профессиональное программирование на VBA в Excel 2003. – СПб: Издательский дом “Вильямс”, 2005. – 800 с.
3. Слепцова Л.Д. Программирование на VBA в Microsoft Office 2010. –М: Диалектика-М, 2010. – 432 с.
Приложение а. Листинг наиболее значимых частей программы
Печать карты.
Private Sub CBPrint_Click() 'Печать карты
Dim i As Integer
Dim q2 As Boolean
q2 = False
Select Case CBoxMonthZ.Value
Case "Января"
Mnum = 1
Case "Февраля"
Mnum = 2
Case "Марта"
Mnum = 3
Case "Апреля"
Mnum = 4
Case "Мая"
Mnum = 5
Case "Июня"
Mnum = 6
Case "Июля"
Mnum = 7
Case "Августа"
Mnum = 8
Case "Сентября"
Mnum = 9
Case "Октября"
Mnum = 10
Case "Ноября"
Mnum = 11
Case "Декабря"
Mnum = 12
Case Else
MP1.Value = 0
MsgBox Prompt:="Некорректная дата заполнения!", Title:="Ошибка!"
GoTo Konec
End Select
q2 = (Prov(CBDisp, TBDisp)) Or (Prov(CBRach, TBRach)) Or (Prov(CBOsp, TBOsp)) Or (Prov(CBGep, TBGep))
q2 = (q2) Or (Prov(CBDif, TBDif)) Or (Prov(CBPar, TBPar)) Or (Prov(CBKor, TBKor)) Or (Prov(CBKra, TBKra))
q2 = (q2) Or (Prov(CBSca, TBSca)) Or (Prov(CBTr, TBTr)) Or (Prov(CBLor, TBLor)) Or (Prov(CBOds, TBOds))
q2 = (q2) Or (Prov(CBAll, TBAll)) Or (Prov(CBEndokr, TBEndokr)) Or (Prov(CBJkt, TBJkt))
q2 = (q2) Or (Prov(CBSerd, TBSerd)) Or (Prov(CBNerv, TBNerv)) Or (Prov(CBImmun, TBImmun))
q2 = (q2) Or (Prov(CBKari, TBKari)) Or (Prov(CBPara, TBPara))
If q2 <> True Then 'Проверка на наличие пустых полей ввода
Dim oWord As Word.Application
Dim oDoc As Word.Document
Set oWord = CreateObject("Word.Application")
Set oDoc = oWord.Documents.Add()
oWord.Visible = True
oDoc.Activate
i = 0
With oWord.Selection
.Style = "Заголовок 1"
.ParagraphFormat.Alignment = wdAlignParagraphCenter
.TypeText "Медицинская карта №" & Space(1) & TBNumberK.Text
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times new roman"
.Font.Size = 14
.TypeText "Дата заполнения:" & Space(1) & TBDayZ.Text & Space(1) & CBoxMonthZ.Text & Space(1) & TBYearZ
.TypeParagraph
.TypeText "Врач ортодонт:" & Space(1) & TBDoctor
.TypeParagraph
.Style = "Заголовок 2"
.TypeText "1. Паспортная часть"
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times new roman"
.Font.Size = 14
.TypeText "ФИО пациента:" & Space(1) & TBFIOP1.Value & Space(1) & TBFIOP2.Value & Space(1) & TBFIOP3.Value
.TypeParagraph
.TypeText "Пол:" & Space(1)
If OBGenderM.Value = True Then
.TypeText "Мужской"
Else
.TypeText "Женский"
End If
.TypeParagraph
.TypeText "Дата рождения:" & Space(1) & TBBD.Text & "." & TBBM.Text & "." & TBBY.Text
.TypeParagraph
.TypeText "Адрес:" & Space(1) & TBAdress.Value
.TypeParagraph
.TypeText "Телефон" & Space(1)
.TypeText "Д:" & Space(1) & TBD.Value
.TypeText Space(3) & "Р:" & Space(1) & TBR.Value
.TypeText Space(3) & "М:" & Space(1) & TBM.Value
.TypeParagraph
.TypeText "ФИО родителей:" & Space(1)
.TypeText TBFIOM.Value & "," & Space(1) & TBFIOF.Value
.TypeParagraph
.TypeText "Место работы, занимаемая должность родителей:"
.TypeParagraph
.TypeText Space(2) & "Мать:" & Space(1) & TBWorkM.Value
.TypeParagraph
.TypeText Space(2) & "Отец:" & Space(1) & TBWorkF.Value
.TypeParagraph
.TypeText "Страховой полис:"
.TypeParagraph
.TypeText Space(2) & TBCompany.Value & Space(1)
.TypeText TBSerie.Value & "-" & TBNumber.Value
.TypeParagraph
.Style = "Заголовок 2"
.TypeText "2. Направлен в клинику"
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times new roman"
.Font.Size = 14
.TypeText "(кем) ФИО:" & Space(1) & TBNaprDoct.Text
.TypeParagraph
.TypeText "С диагнозом:" & Space(1)
If CBNaprDiag.Value = True Then
.TypeText "-"
Else
.TypeText TBNaprDiag.Text
End If
.TypeParagraph
.TypeText "Ранее" & Space(1)
If CBNaprL.Value = False Then
.TypeText "не лечился"
Else
.TypeText "лечился, длительность лечения -" & Space(1) & TBNaprL.Value
.TypeText Space(1) & "лет"
End If
.TypeParagraph
.TypeText "Вид аппаратуры:" & Space(1)
If OBNaprTypeS.Value = True Then
.TypeText "Съёмная"
Else
.TypeText "Несъёмная"
End If
.TypeParagraph
.Style = "Заголовок 2"
.TypeText "3. Анамнез"
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times New Roman"
.Font.Size = 14
.TypeText "Жалобы:" & Space(1)
If CBGEst.Value = True Then
.TypeText "Эстетические;" & Space(1)
i = i + 1
End If
If CBGMorf.Value = True Then
.TypeText "Морфологические;" & Space(1)
i = i + 1
End If
If CBGFunc.Value = True Then
.TypeText "Функциональные нарушения;" & Space(1)
i = i + 1
End If
If i = 0 Then
.TypeText "Отсутствуют"
End If
.TypeParagraph
.Style = "Заголовок 2"
.TypeText "4. Общие сведения"
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times New Roman"
.Font.Size = 14
.TypeText "Нарушения здоровья матери во время беременности (триместр):" & Space(1)
If OBTrimestr1.Value = True Then
.TypeText "I"
ElseIf OBTrimestr2.Value = True Then
.TypeText "II"
ElseIf OBTrimestr3.Value = True Then
.TypeText "III"
Else
.TypeText "Отсутствовали"
End If
.TypeParagraph
.TypeText "Рождён" & Space(1)
If OBBirthY.Value = True Then
.TypeText "в срок"
Else
.TypeText "недоношенным"
End If
.TypeParagraph
.TypeText "Вид вскармливания:" & Space(1)
If OBVNorm.Value = True Then
.TypeText "Естественное"
ElseIf OBVArt.Value = True Then
.TypeText "Искусственное"
Else
.TypeText "Смешанное"
End If
If Not (OBVNorm.Value = True) Then
.TypeText "," & Space(1) & "c" & Space(1) & TBVMonth.Value & Space(1) & "месяца"
End If
.TypeParagraph
.TypeText "Начало прорезывания первых молочных зубов:" & Space(1) & TBMTeeth.Value & Space(1)
Select Case TBMTeeth.Value
Case "1"
.TypeText "месяц"
Case "2", "3", "4"
.TypeText "месяца"
Case Else
.TypeText "месяцев"
End Select
.TypeParagraph
.TypeText "Начало смены первых постоянных зубов:" & Space(1) & TBPTeeth.Value & Space(1)
Select Case TBPTeeth.Value
Case "1"
.TypeText "год"
Case "2", "3"
.TypeText "года"
Case Else
.TypeText "лет"
End Select
.TypeParagraph
.TypeText "Нарушения осанки:" & Space(1)
If OBOSY.Value = True Then
.TypeText "Имеются"
Else
.TypeText "Не имеются"
End If
.TypeParagraph
.Style = "Заголовок 2"
.TypeText "5. Перенесённые и сопутствующие заболевания"
.TypeParagraph
.Style = "Обычный"
.Font.Name = "Times New Roman"
.Font.Size = 14
Il oWord, CBDisp, "Диспепсия", TBDisp, CBDispV
Il oWord, CBRach, "Рахит", TBRach, CBRachV
Il oWord, CBOsp, "Ветряная оспа", TBOsp, CBOspV
Il oWord, CBGep, "Гепатит", TBGep, CBGepV
Il oWord, CBDif, "Дифтерия", TBDif, CBDifV
Il oWord, CBPar, "Инф. паротит", TBPar, CBParV
Il oWord, CBKor, "Корь", TBKor, CBKorV
Il oWord, CBKra, "Краснуха", TBKra, CBKraV
Il oWord, CBSca, "Скарлатина", TBSca, CBScaV
Il oWord, CBTr, "Травма", TBTr, CBTrV
Il oWord, CBLor, "Заболевания ЛОР-органов", TBLor, CBLorV
Il oWord, CBOds, "Заболевания опорно-двигательного аппарата", TBOds, CBOdsV
Il oWord, CBAll, "Аллергия", TBAll, CBAllV
Il oWord, CBEndokr, "Эндокр. заболевания", TBEndokr, CBEndokrV
Il oWord, CBJkt, "Болезни ЖКТб печени, почек", TBJkt, CBJktV
Il oWord, CBSerd, "Болезни сердца", TBSerd, CBSerdV
Il oWord, CBNerv, "Болезни нервной системы", TBNerv, CBNervV
Il oWord, CBImmun, "Иммунодефицит", TBImmun, CBImmunV
Il oWord, CBKari, "Множественный кариес", TBKari, CBKariV
Il oWord, CBPara, "Парадонтопатия", TBPara, CBParaV
For i = 0 To LBB.ListCount - 1
.TypeText LBB.List(i) & ";" & h13
Next
End With
Else
MsgBox "Введены не все данные!", Title:="Ошибка!"
End If
Konec: 'Метка выхода из процедуры
End Sub
Внесение в таблицу Excel.
Private Sub CBExcel_Click() 'Внесение данных таблицы Excel
Dim i As Boolean
Dim YN As Integer
Columns("A:A").ColumnWidth = 11 'Регулировка ширины столбцов
Columns("B:B").ColumnWidth = 20
Columns("C:C").ColumnWidth = 15
Columns("D:D").ColumnWidth = 10
Columns("E:E").ColumnWidth = 11
Columns("F:F").ColumnWidth = 20
Columns("G:G").ColumnWidth = 20
Columns("H:H").ColumnWidth = 25
Columns("I:I").ColumnWidth = 25
Columns("J:J").ColumnWidth = 25
Columns("K:K").ColumnWidth = 25
Columns("L:L").ColumnWidth = 42
Columns("M:M").ColumnWidth = 42
Columns("N:N").ColumnWidth = 42
Columns("O:O").ColumnWidth = 25
Columns("P:P").ColumnWidth = 25
Columns("Q:Q").ColumnWidth = 25
Columns("R:R").ColumnWidth = 25
Columns("S:S").ColumnWidth = 25
Columns("T:T").ColumnWidth = 25
Columns("U:U").ColumnWidth = 25
Columns("V:V").ColumnWidth = 25
Columns("W:W").ColumnWidth = 30
Columns("X:X").ColumnWidth = 30
Columns("Y:Y").ColumnWidth = 25
If OBTest1.Value <> True Then
YN = MsgBox("Вывести заголовок?", vbYesNo, "Заголовок") 'Запрос на ввод заголовка
End If
If YN = 6 Then
Cells(ActiveCell.Row, 1).Select 'Ввод заголовка
ActiveCell.FormulaR1C1 = "Номер карты"
Cells(ActiveCell.Row, 2).Select
ActiveCell.FormulaR1C1 = "Врач - ортодонт"
Cells(ActiveCell.Row, 3).Select
ActiveCell.FormulaR1C1 = "Фамилия"
Cells(ActiveCell.Row, 4).Select
ActiveCell.FormulaR1C1 = "Имя"
Cells(ActiveCell.Row, 5).Select
ActiveCell.FormulaR1C1 = "Отчество"
Cells(ActiveCell.Row, 6).Select
ActiveCell.FormulaR1C1 = "Дата рождения"
Cells(ActiveCell.Row, 7).Select
ActiveCell.FormulaR1C1 = "Страховой полис"
Cells(ActiveCell.Row, 8).Select
ActiveCell.FormulaR1C1 = "Домашний телефон"
Cells(ActiveCell.Row, 9).Select
ActiveCell.FormulaR1C1 = "Рабочий телефон"
Cells(ActiveCell.Row, 10).Select
ActiveCell.FormulaR1C1 = "Мобильный телефон"
Cells(ActiveCell.Row, 11).Select
ActiveCell.FormulaR1C1 = "Мать"
Cells(ActiveCell.Row, 12).Select
ActiveCell.FormulaR1C1 = "Отец"
Cells(ActiveCell.Row, 13).Select
ActiveCell.FormulaR1C1 = "Место работы и занимаемая должность матери"
Cells(ActiveCell.Row, 14).Select
ActiveCell.FormulaR1C1 = "Место работы и занимаемая должность отца"
Cells(ActiveCell.Row, 15).Select
ActiveCell.FormulaR1C1 = "Направляющий врач"
Cells(ActiveCell.Row, 16).Select
ActiveCell.FormulaR1C1 = "Диагноз"
Cells(ActiveCell.Row, 17).Select
ActiveCell.FormulaR1C1 = "Лечился ли ранее (период)"
Cells(ActiveCell.Row, 18).Select
ActiveCell.FormulaR1C1 = "Вид аппаратуры"
Cells(ActiveCell.Row, 19).Select
ActiveCell.FormulaR1C1 = "Жалобы (тип)"
Cells(ActiveCell.Row, 20).Select
ActiveCell.FormulaR1C1 = "Нарушения здоровья матери (триместр беременности)"
Cells(ActiveCell.Row, 21).Select
ActiveCell.FormulaR1C1 = "Рождён"
Cells(ActiveCell.Row, 22).Select
ActiveCell.FormulaR1C1 = "Вскармливание"
Cells(ActiveCell.Row, 23).Select
ActiveCell.FormulaR1C1 = "Первыые молочные зубы (прорезывание), месяцев"
Cells(ActiveCell.Row, 24).Select
ActiveCell.FormulaR1C1 = "Первые постоянные зубы (смена), лет"
Cells(ActiveCell.Row, 25).Select
ActiveCell.FormulaR1C1 = "Нарушения осанки"
Cells(ActiveCell.Row + 1, 1).Select
End If
ActiveCell.FormulaR1C1 = TBNumberK.Value 'Ввод данных в таблицу
Cells(ActiveCell.Row, 2).Select
ActiveCell.FormulaR1C1 = TBDoctor.Value
Cells(ActiveCell.Row, 3).Select
ActiveCell.FormulaR1C1 = TBFIOP1.Value
Cells(ActiveCell.Row, 4).Select
ActiveCell.FormulaR1C1 = TBFIOP2.Value
Cells(ActiveCell.Row, 5).Select
ActiveCell.FormulaR1C1 = TBFIOP3.Value
Cells(ActiveCell.Row, 6).Select
ActiveCell.FormulaR1C1 = TBBD.Text & "." & TBBM.Text & "." & TBBY.Text
Cells(ActiveCell.Row, 7).Select
ActiveCell.FormulaR1C1 = TBCompany.Value & " " & TBSerie.Value & "-" & TBNumber.Value
Cells(ActiveCell.Row, 8).Select
ActiveCell.FormulaR1C1 = “’” & TBD.Value
Cells(ActiveCell.Row, 9).Select
ActiveCell.FormulaR1C1 = “’” & TBR.Value
Cells(ActiveCell.Row, 10).Select
ActiveCell.FormulaR1C1 = “’” & TBM.Value
Cells(ActiveCell.Row, 11).Select
ActiveCell.FormulaR1C1 = TBFIOM.Value
Cells(ActiveCell.Row, 12).Select
ActiveCell.FormulaR1C1 = TBFIOF.Value
Cells(ActiveCell.Row, 13).Select
ActiveCell.FormulaR1C1 = TBWorkM.Value
Cells(ActiveCell.Row, 14).Select
ActiveCell.FormulaR1C1 = TBWorkF.Value
Cells(ActiveCell.Row, 15).Select
ActiveCell.FormulaR1C1 = TBNaprDoct.Text
Cells(ActiveCell.Row, 16).Select
If CBNaprDiag.Value = True Then
ActiveCell.FormulaR1C1 = "-"
Else
ActiveCell.FormulaR1C1 = TBNaprDiag.Text
End If
Cells(ActiveCell.Row, 17).Select
If CBNaprL.Value = False Then
ActiveCell.FormulaR1C1 = "не лечился"
Else
ActiveCell.FormulaR1C1 = TBNaprL.Value & " " & "лет"
End If
Cells(ActiveCell.Row, 18).Select
If OBNaprTypeS.Value = True Then
ActiveCell.FormulaR1C1 = "Съёмная"
Else
ActiveCell.FormulaR1C1 = "Несъёмная"
End If
Cells(ActiveCell.Row, 19).Select
If CBGEst.Value = True Then
ActiveCell.FormulaR1C1 = "Эстетические;" & " "
i = True
End If
If CBGMorf.Value = True Then
ActiveCell.FormulaR1C1 = "Морфологические;" & " "
i = True
End If
If CBGFunc.Value = True Then
ActiveCell.FormulaR1C1 = "Функциональные нарушения;" & " "
i = True
End If
If i = False Then
ActiveCell.FormulaR1C1 = "Отсутствуют"
End If
Cells(ActiveCell.Row, 20).Select
If OBTrimestr1.Value = True Then
ActiveCell.FormulaR1C1 = "I"
ElseIf OBTrimestr2.Value = True Then
ActiveCell.FormulaR1C1 = "II"
ElseIf OBTrimestr3.Value = True Then
ActiveCell.FormulaR1C1 = "III"
Else
ActiveCell.FormulaR1C1 = "Отсутствовали"
End If
Cells(ActiveCell.Row, 21).Select
If OBBirthY.Value = True Then
ActiveCell.FormulaR1C1 = "в срок"
Else
ActiveCell.FormulaR1C1 = "недоношенным"
End If
Cells(ActiveCell.Row, 22).Select
If OBVNorm.Value = True Then
ActiveCell.FormulaR1C1 = "Естественное"
ElseIf OBVArt.Value = True Then
ActiveCell.FormulaR1C1 = "Искусственное"
Else
ActiveCell.FormulaR1C1 = "Смешанное"
End If
Cells(ActiveCell.Row, 23).Select
ActiveCell.FormulaR1C1 = TBMTeeth.Value
Cells(ActiveCell.Row, 24).Select
ActiveCell.FormulaR1C1 = TBPTeeth.Value
Cells(ActiveCell.Row, 25).Select
If OBOSY.Value = True Then
ActiveCell.FormulaR1C1 = "Имеются"
Else
ActiveCell.FormulaR1C1 = "Не имеются"
End If
Cells(ActiveCell.Row + 1, 1).Select
OBTest1.Value = True
End Sub