Rec.MoveLast
Rec.MoveFirst
sergey-911 писал(а):Для этого, перед основным оператором Select (с условием), я запускаю еще один Select Count (с тем же условием), который выводит количество строк.
rs.recordcount
rs.MoveLast
rs.MoveFirst
form1.progressbar1.min=1
form1.progressbar1.max=rs.recordcount
rs.movefirst
i=1
do until rs.eof
form1.progressbar1.value=i
...заполняешь таблицу текущей записью
rs.movenext
i=i+1
loop
rs.close
sergey-911 писал(а):Если тебе не в лом - скинь исходник с анимацией.
Rs.CursorLocation = adUseClient
Private Sub RefreshLv(where As String, ID As Long)
On Error GoTo Er
Dim query As String
Dim j As Long
Dim itmX As ListItem
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Dim Flag As Boolean
lvMain.ListItems.Clear
lvMain.ColumnHeaders(Kol + 1).Width = 0 '1 - количество идентификаторов
query = query & "SELECT COUNT (*) "
query = query & "FROM Munits "
Set cn = New ADODB.Connection
cn.Open (Soedinenie)
Set rs = cn.Execute(query & where) 'подсчет суммы записей в БД
'V Прогрес бар*********************************************************************************************************************
If Not IsNull(rs.Fields(0)) And rs.Fields(0) > 0 Then
frmWait.ProgressBar1.Min = 0
frmWait.ProgressBar1.Max = rs.Fields(0)
End If
frmWait.Height = 2185
frmWait.ProgressBar1.Visible = True
frmWait.Refresh
'A Прогрес бар*********************************************************************************************************************
query = "SELECT "
query = query & "Munits.Nazv, " '(0)
query = query & "Munits.Tel, " '(1)
query = query & "Munits.Mesto, " '(2)
query = query & "Munits.MunitsID " '(3)
query = query & "FROM Munits "
Set rs = cn.Execute(query & where & " ORDER BY Munits.Nazv")
' Здесь должен работать rs.recordcount
Do Until rs.EOF
If IsNull(rs.Fields(0)) Then
Set itmX = lvMain.ListItems.Add(, , "", 0, 0)
Else
Set itmX = lvMain.ListItems.Add(, , rs.Fields(0), 0, 0)
End If
If IsNull(rs.Fields(1)) Then
itmX.SubItems(1) = ""
Else
itmX.SubItems(1) = rs.Fields(1)
End If
If IsNull(rs.Fields(2)) Then
itmX.SubItems(2) = ""
Else
itmX.SubItems(2) = rs.Fields(2)
End If
If IsNull(rs.Fields(3)) Then
itmX.SubItems(3) = ""
Else
itmX.SubItems(3) = rs.Fields(3)
'V Выделяем правленную запись в таблице путем сравнения идентификатора****************************************************
If ID > 0 And ID = rs.Fields(3) Then
For j = 1 To CLng(Me.lvMain.ListItems.Count)
'V InStr - сравнить ==> сравниваем только, что найденный ID с существующим в таблице
If CLng(InStr(CStr(lvMain.ListItems(j).ListSubItems(3).Text), CStr(rs.Fields(3)))) > 0 Then
lvMain.SelectedItem = lvMain.ListItems(j) 'Курсор на нужную запись
Exit For
End If
Next j
End If
'A Выделяем правленную запись в таблице путем сравнения идентификатора****************************************************
End If
'Следующая запись
rs.MoveNext
'V Обновление прогресбара*******************************************************************************************************
If frmWait.ProgressBar1.Value < frmWait.ProgressBar1.Max Then
frmWait.ProgressBar1.Value = frmWait.ProgressBar1.Value + 1 'прогрес бар
End If
'A Обновление прогресбара*******************************************************************************************************
Loop
rs.Close
Set rs = Nothing
Set cn = Nothing
lvMain.Refresh
If Me.lvMain.ListItems.Count > 0 Then 'Таблица заполнена
If j > 0 Then 'В случае, если была помечена запись
lvMain.SelectedItem.EnsureVisible 'Переход на указанную строку
Else 'В случае, если запись не была помечена
lvMain.SelectedItem = lvMain.ListItems(1) 'Курсор на нужную запись
lvMain.SelectedItem.EnsureVisible 'Переход на указанную строку
End If
End If
'V скрытие формы ожидания*******************************************************************************************************
frmWait.Hide
'A скрытие формы ожидания*******************************************************************************************************
Exit Sub
Er:
Set rs = Nothing
Set cn = Nothing
'V скрытие формы ожидания*******************************************************************************************************
frmWait.Hide
'A скрытие формы ожидания*******************************************************************************************************
MsgBox "Error " & Err.Number & ": " & Err.Description, vbOKOnly + vbCritical, "Error"
End Sub
Dim rs As ADODB.Recordset
Dim cn As ADODB.Connection
Set cn = New ADODB.Connection
cn.CursorLocation = adUseClient 'Клиентский курсор
Dim Soedinenie As String 'Параметры подключения
cn.Open (Soedinenie)
....
'Выполнение запроса и заполнение сетки.
...
MsgBox (rs.RecordCount) 'Количество записей
rs.Close
Set rs = Nothing
Set cn = Nothing
sergey-911 писал(а):А клиентский курсор, насколько я понимаю, это отсоединенный набор записей. Это накладывает какие-либо ограничения при работе с ним?
Сейчас этот форум просматривают: Google-бот и гости: 182