VB中怎么分页？

DataGrid控件可以实现分页吗？

什么意思？是datagrid分页呢？还是打印的时候分页呢？

用ADO分页处理的示例AbsolutePage、PageCount 和 PageSize 属性范例
该范例使用 AbsolutePage、PageCount 和 PageSize 属性，以每次五个记录的方式显示雇员表中的姓名和受雇日期。Public Sub AbsolutePageX()

   Dim rstEmployees As ADODB.Recordset
   Dim strCnn As String
   Dim strMessage As String
   Dim intPage As Integer
   Dim intPageCount As Integer
   Dim intRecord As Integer   ' 使用客户端游标为雇员表打开一个记录集。
   strCnn = "Provider=sqloledb;" & _
      "Data Source=srv;Initial Catalog=pubs;User Id=sa;Password=; "
   Set rstEmployees = New ADODB.Recordset
   ' 使用客户端游标激活 AbsolutePosition 属性。
   rstEmployees.CursorLocation = adUseClient
   rstEmployees.Open "employee", strCnn, , , adCmdTable

   ' 显示姓名和受雇日期，每次五个记录。
   rstEmployees.PageSize = 5
   intPageCount = rstEmployees.PageCount
   For intPage = 1 To intPageCount
      rstEmployees.AbsolutePage = intPage
      strMessage = ""
      For intRecord = 1 To rstEmployees.PageSize
         strMessage = strMessage & _
            rstEmployees!fname & " " & _
            rstEmployees!lname & " " & _
            rstEmployees!hire_date & vbCr
         rstEmployees.MoveNext
         If rstEmployees.EOF Then Exit For
      Next intRecord
      MsgBox strMessage
   Next intPage
   rstEmployees.CloseEnd Sub

用sql server数据库的话,参考我的贴子：查询第X页,每页Y条记录
http://expert.csdn.net/Expert/topic/2365/2365596.xml?temp=.8605615

打印的时候报表会自动的处理分页!
显示的时候分页,看你用什么控件显示,如果是STRINGGRID,在显示的时候通过程序处理就可以,也可以通过SQL来进行!如果是用DBGRID绑定,就只有用SQL语句来处理了:如下:
SELECT TOP 5 * FROM
(SELECT TOP 10 * FROM ADEPART) AS MAIN ORDER BY CODE DESC
这是取表ADEPART中5到10条的数据,CODE是主键!

先設計Excel範本，然後程式裏面判斷分頁，給你個打印入庫單的例子
打印機
2，首先在模組裏面定義一些需要使用的公共Function
Dim fWait As frmWaiting'****************************************************************************************************************
'*   填入 Excel
'****************************************************************************************************************
Public Function Prnrkd(ByVal rsTMP As ADODB.Recordset, strcartqty As String, ilots As Integer, Optional ByVal DefPrnName As String = "NoDefPrnName") As Boolean
'傳遞rsTMP(包含入庫單裏面的信息），strcartqty:每種prodid的數量總和,和紙張數,打印機
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlWSheet As Excel.Worksheet
Dim TmpFile As String    '讀取Excel範本的路徑Dim i As Integer
Dim iPage As Integer  '用來標誌打印的頁數
Dim blnEOF As Boolean '初始時為False,打印到數據結尾時讓其值為TrueOn Error GoTo ProErr
    Prnrkd = False   '初始化函數返回值為False    TmpFile = IIf(Right(App.Path, 1) = "\", App.Path & "RunCard\" & "ProductBankInTemp.xls", App.Path & "\RunCard\" & "ProductBankInTemp.xls")
    If Dir(TmpFile) <> "" Then Kill TmpFile '讀取Excel臨時範本的路徑，並刪除此文件
    If Dir(App.Path & "\RunCard\ProductBankIn.xls") = "" Then  '找出原始Excel文檔
        MsgBox "找不到Excel檔." & App.Path & "\RunCard\ProductBankIn.xls" & " ，無法列印，請檢查是否存在!!", vbInformation, "提示"
        Exit Function
    End If    FileCopy App.Path & "\RunCard\ProductBankIn.xls", TmpFile   '複製原始Excel文檔，並存放在TmpFile指定的位置    WaitOn    Set xlApp = CreateObject("EXCEL.APPLICATION")
    With xlApp
    On Error Resume Next        Set xlBook = .Workbooks.Open(TmpFile)
        If Err.Number <> 0 Then
            MsgBox Err.Description, vbCritical, "提示"
            xlApp.Quit
            Set xlApp = Nothing
            Set xlBook = Nothing
            Exit Function
        End If
        Set xlWSheet = .Worksheets("Sheet1")
        xlWSheet.Unprotect    'Workbook?象的Unprotect方法用于取消?工作簿的保?。Unprotect方法只有一??量，就是保?工作表?所用的口令。        .Visible = False
    End With    iPage = 1    '標誌打印第一頁
    blnEOF = False
    With xlApp
        .Cells(8, 1) = "申請日期 : " & Format(Now, "YYYY-MM-DD")
        .Cells(11, 9) = "Total : " & strcartqty
        .Cells(11, 11) = iPage & " / " & LL(ilots / 12)   'ilots 表示所有數據的紀錄數，每張Excel檔打印12筆紀錄
        rsTMP.MoveFirst
        For i = 1 To 12
            If blnEOF = False Then
                .Cells(12 + i, 1) = Trim("" & rsTMP("id").Value)
                .Cells(12 + i, 2) = Trim("" & rsTMP("name").Value)
                .Cells(12 + i, 3) = Trim("" & rsTMP("class").Value)


            Else
                .Cells(12 + i, 1) = ""
                .Cells(12 + i, 2) = ""
                .Cells(12 + i, 3) = ""

            End If
            If i = 12 Then
                xlWSheet.PageSetup.Zoom = False  '************不用縮成一頁
                xlWSheet.PageSetup.FitToPagesTall = 1
                xlWSheet.PageSetup.FitToPagesWide = 1
                xlWSheet.PrintOut
                i = 0
                iPage = iPage + 1  '每打印完一張，張數纍加
                .Cells(11, 11) = iPage & " / " & LL(ilots / 12)
                If blnEOF = True Then Exit For   '數據打印完畢
            End If
            rsTMP.MoveNext
            If rsTMP.EOF Then  '數據遍歷結束
                blnEOF = True
            End If
        Next i     End With    WaitOff'    If Err.Number <> 0 Then
'        MsgBox Err.Description, vbCritical, "提示"
'    End If
    xlBook.Close False, "", False  '*******************
    xlApp.Quit    Set xlWSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = Nothing
    If Dir(TmpFile) <> "" Then Kill TmpFile
    Prnrkd = True    Exit Function
ProErr:
    If Err.Number = 70 Then
        MsgBox "請先關閉此Report的Excel範本,再列印 !!!", 16
    Else
        MsgBox "From Load Error in UCPalette1_PrintClick Sub !!" & vbCrLf & Err.Description, 16
    End If
    On Error Resume Next
    If Dir(TmpFile) <> "" Then Kill TmpFile
    WaitOff
    Set xlWSheet = Nothing
    Set xlBook = Nothing
    Set xlApp = NothingEnd Function
'************************************************************************************************************
'*         waiton
'************************************************************************************************************Public Sub WaitOn(Optional ByVal Msg As String = "作業執行中 ......")
On Error Resume Next
'Dim fWait As frmWaiting
' If OnTest Then Exit Sub
Screen.MousePointer = vbHourglass
If Not (fWait Is Nothing) Then
    With fWait
        .Show
        .ZOrder
        .Refresh
        Exit Sub
    End With
End If
Set fWait = frmWaiting
'   Dim fWait As New frmWaiting
Load fWait
With fWait
    .lblMsg.Caption = Msg
    .Show
    .ZOrder
    .Refresh
    .Refresh
    If Not IsLen0(Msg) Then
       .lblMsg = Msg
    End If
    .Show
    'Unload fWait
End With
End Sub
'*******************************************************************************************************************
'*   wait off
'*******************************************************************************************************************
Public Sub WaitOff()
On Error Resume Next
   'Dim fWait As frmWaiting
'  If OnTest Then Exit Sub
   Screen.MousePointer = 0   '恢復鼠標為正常狀態
   If fWait Is Nothing Then Exit Sub
   Unload fWait              '關閉等待界面
   Set fWait = Nothing

End Sub'*******************************************************************************************************************
'*  LL
'*******************************************************************************************************************Public Function LL(ByVal lngQty As Double) As Long
    Dim iFix As Long   '如果不是整除的話，不足一頁也要算一頁
    iFix = Fix(lngQty)
    If iFix <> lngQty Then
        iFix = iFix + 1
    End If
    LL = iFix
End Function'*******************************************************************************************************************
'*
'*******************************************************************************************************************Public Function IsLen0(ByVal obj) As Boolean
'判斷字元長度是否為0
   On Error GoTo errIsLen0
   IsLen0 = Len(Trim(obj & "")) = 0
   Exit FunctionerrIsLen0:
   MsgBox "Value incorrected", , "IsLen0 Error"
   IsLen0 = True
   Exit FunctionEnd Function'*************************************************************************************************************
'*  設置 Frmwaiting 置予界面中間
'**************************************************************************************************************
Public Sub CenterForm(x_YourForm As Form)
    ' center the passed form to screen
    x_YourForm.Move Abs(Screen.Width - x_YourForm.Width) \ 2, Abs(Screen.Height - x_YourForm.Height) \ 2 - 400
End Sub
2,
Private Sub Form_Load()
   conn.myconn.Open

    Dim i As Integer
    Dim X As Printer

    chkprn = True
    If Printers.Count < 1 Then
        MsgBox "此電腦無安裝印表機 ,請安裝後再重試 !!!"
        chkprn = False
        Exit Sub
    End If
    For Each X In Printers
        CboPrn.AddItem X.DeviceName
    Next X
End Sub3,讀出結果送入打印機
Private Sub Command2_Click()
    Dim rs As ADODB.Recordset
    Dim sql As String
    Dim DefPrnName As String
    DefPrnName = Trim(CboPrn.Text)
    sql = " select * from student"
    Set rs = conn.myconn.Execute(sql)
    If rs.RecordCount > 0 Then
       Set TDBGrid1.DataSource = rs
       If Prnrkd(rs, 30, 10, DefPrnName) = False Then Exit Sub
    End IfEnd Sub

谢谢大家的帮忙
如果像“zjcxc(: 邹建 :)”朋友说的那样分页，上一页、下一页的代码又分别是什么？
谢谢！

调试易

VB中怎么分页？

解决方案 »