Долго меня не было, надеюсь все живы-здоровы.
При первичной загрузке грида все ОК.
Я хочу, чтобы при появлении еще одного исследования у клиента грид "перерисовывался" заново, чтобы это исследование появлялось в гриде. Тут начинаются закавыки - не выполняется hflIss.AddItem в первой строке, т.е., она остается пустой, без фамилии. Иногда и вторая-третья строка не заполняются, уже с исследованиями. Иногда все строки добавляются. Какой-либо закономерности не выявил. В чем дело - не пойму.
Процедуру issLoad вызываю из других форм (ввод результатов исследований) следующим образом:
- Код: Выделить всё
With rsEKG
.AddNew
'***************** сохранение значений в полях в БД
.Update
.Close
End With
frmList.issLoad 'frmList - форма, на которой лежит грид
Просветите, меня, пожалуйста.
Приложение (48кБ): Рисунок Grid1 - первичная прорисовка грида, Grid2 - прорисовка грида после добавления нового исследования (вернее, непрорисовка)
- Код: Выделить всё
Public Sub issLoad() 'загрузка и форматирование таблицы
Dim rsBAK As New ADODB.Recordset, rsEKG As New Recordset, rsOAK As New Recordset, _
rsOAM As New Recordset, rsUZI As New Recordset, rsOth As New Recordset
hflIss.Clear 'очищаем грид
hflIss.Rows = hflIss.FixedRows + 1 'убираем все пустые строки
sSQL = "SELECT nBol, Fam, Name, Otch FROM Pasp ORDER BY Fam"
rsIss.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsIss.RecordCount <> 0 Then 'если есть записи клиентов, то начинаем заполнять грид
Do While Not rsIss.EOF 'пока не конец таблицы БД
'добавляем в грид строку с фамилией
hflIss.AddItem "-" & vbTab & rsIss.Fields("nBol") & vbTab & rsIss.Fields("Fam") & " " & _
IIf(Trim(rsIss.Fields("Name")) = "", "", Left(rsIss.Fields("Name"), 1) & ".") & _
IIf(Trim(rsIss.Fields("Otch")) = "", "", Left(rsIss.Fields("Otch"), 1) & ".")
'добавляем строки с исследованиями из других таблиц БД
sSQL = "SELECT nIssl, DateIs, TimeIs, Zakl FROM BAK WHERE BAK.nBol = " & _
rsIss.Fields("nBol") & " ORDER BY nIssl, DateIs, TimeIs"
rsBAK.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsBAK.RecordCount <> 0 Then 'если есть записи в таблице "BAK"
Do While Not rsBAK.EOF 'пока не конец таблицы
hflIss.AddItem vbTab & "БАК" & vbTab & vbTab & _
rsBAK.Fields("nIssl") & vbTab & rsBAK.Fields("DateIs") & vbTab & _
Format(rsBAK.Fields("TimeIs"), "hh:mm") & vbTab & rsBAK.Fields("Zakl")
rsBAK.MoveNext
Loop
End If
rsBAK.Close
'******************
sSQL = "SELECT nIssl, DateIs, TimeIs, Zakl FROM UZI WHERE UZI.nBol = " & rsIss.Fields("nBol") & _
" ORDER BY nIssl, DateIs, TimeIs"
rsUZI.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsUZI.RecordCount <> 0 Then
Do While Not rsUZI.EOF
hflIss.AddItem vbTab & "УЗИ" & vbTab & vbTab & _
rsUZI.Fields("nIssl") & vbTab & rsUZI.Fields("DateIs") & vbTab & _
Format(rsUZI.Fields("TimeIs"), "hh:mm") & vbTab & rsUZI.Fields("Zakl")
rsUZI.MoveNext
Loop
End If
rsUZI.Close
'******************
sSQL = "SELECT nIssl, DateIs, TimeIs, Zakl FROM OAM WHERE OAM.nBol = " & rsIss.Fields("nBol") & _
" ORDER BY nIssl, DateIs, TimeIs"
rsOAM.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsOAM.RecordCount <> 0 Then
Do While Not rsOAM.EOF
hflIss.AddItem vbTab & "ОАМ" & vbTab & vbTab & _
rsOAM.Fields("nIssl") & vbTab & rsOAM.Fields("DateIs") & vbTab & _
Format(rsOAM.Fields("TimeIs"), "hh:mm") & vbTab & rsOAM.Fields("Zakl")
rsOAM.MoveNext
Loop
End If
rsOAM.Close
'******************
sSQL = "SELECT nIssl, DateIs, TimeIs, Zakl FROM OAK WHERE OAK.nBol = " & rsIss.Fields("nBol") & _
" ORDER BY nIssl, DateIs, TimeIs"
rsOAK.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsOAK.RecordCount <> 0 Then
Do While Not rsOAK.EOF
hflIss.AddItem vbTab & "ОАК" & vbTab & vbTab & _
rsOAK.Fields("nIssl") & vbTab & rsOAK.Fields("DateIs") & vbTab & _
Format(rsOAK.Fields("TimeIs"), "hh:mm") & vbTab & rsOAK.Fields("Zakl")
rsOAK.MoveNext
Loop
End If
rsOAK.Close
'******************
sSQL = "SELECT nIssl, DateIs, TimeIs, Zakl FROM EKG WHERE EKG.nBol = " & rsIss.Fields("nBol") & _
" ORDER BY nIssl, DateIs, TimeIs"
rsEKG.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsEKG.RecordCount <> 0 Then
Do While Not rsEKG.EOF
hflIss.AddItem vbTab & "ЭКГ" & vbTab & vbTab & _
rsEKG.Fields("nIssl") & vbTab & rsEKG.Fields("DateIs") & vbTab & _
Format(rsEKG.Fields("TimeIs"), "hh:mm") & vbTab & rsEKG.Fields("Zakl")
rsEKG.MoveNext
Loop
End If
rsEKG.Close
'******************
sSQL = "SELECT DateIs, TimeIs, Zakl FROM OthIss WHERE OthIss.nBol = " & rsIss.Fields("nBol")
rsOth.Open sSQL, cnDB, adOpenStatic, adLockReadOnly
If rsOth.RecordCount <> 0 Then
Do While Not rsOth.EOF
hflIss.AddItem vbTab & "Прочие" & vbTab & vbTab & vbTab & rsOth.Fields("DateIs") & vbTab & _
Format(rsOth.Fields("TimeIs"), "hh:mm") & vbTab & rsOth.Fields("Zakl")
rsOth.MoveNext
Loop
End If
rsOth.Close
'******************
rsIss.MoveNext
Loop
End If
rsIss.Close
With hflIss
.RemoveItem 1 'удаляем верхнюю пустую строку грида
For i = .Rows - 1 To 0 Step -1 'выделяем строку с фамилией, инициалами
If .TextArray(i * .Cols) = "-" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellFontBold = True
ElseIf .TextArray(i * .Cols + 1) = "УЗИ" Then '"закрашиваем" фон строк по определенному признаку
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HC0FFC0
ElseIf .TextArray(i * .Cols + 1) = "БАК" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HFFFFC0
ElseIf .TextArray(i * .Cols + 1) = "ОАК" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HC0FFFF
ElseIf .TextArray(i * .Cols + 1) = "ОАМ" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HFFC0C0
ElseIf .TextArray(i * .Cols + 1) = "ЭКГ" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HC0C0FF
ElseIf .TextArray(i * .Cols + 1) = "Прочие" Then
.Row = i: .Col = 1
.ColSel = .Cols - 1
.CellBackColor = &HC0E0FF
End If
Next i
.FormatString = "^|№/Вид |Фамилия, И.О.|№ |Дата |Время |Заключение/Комментарий" 'заголовки столбцов
.ColWidth(0) = 250: .ColWidth(1) = 650
.ColWidth(2) = 2500: .ColWidth(3) = 300
.ColWidth(4) = 900: .ColWidth(5) = 600
.ColWidth(6) = 4500
.ColAlignment(1) = flexAlignLeftCenter: .ColAlignment(2) = flexAlignLeftCenter
.ColAlignment(3) = flexAlignCenterCenter: .ColAlignment(4) = flexAlignCenterCenter
.ColAlignment(5) = flexAlignCenterCenter
.MergeCells = flexMergeFree: .MergeCol(1) = True 'разрешаем слияние ячеек
End With
End Sub
С уважением и благодарностью - Dummiel
P.S. В приложении дополнительная инфа по другим процедурам, использующих сворачивание/разворачивание этого грида.
P.P.S. Пожалуйста, не спрашивайте меня, почему я заполняю грид циклами ("вручную"). Меня эстетически не устраивают ленты по SQL-выборке, и не устраивает привязка к БД по DataSource. Пробовал. Вот такая блажь.
И потом, как "разукрасить" строки с различными исследованиями, если пользуешь привязки DataSource? Вот и я о том же... 
