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