***VB中的文本框、报表问题***

Question

www.vbeden.com
www.vbgood.com
www.21code.com
源代码，书籍

Answer 1

为简单起见下面的程序代码仍将整个表的数据导出到电子表格中。如果你有兴趣的话，对下面的代码稍加改动就可做成更为通用的一个类或是一个控件。 首先在窗体上添加一个标签控件和一个命令按钮，然后在工程中添加对DAO引用。利用下面的程序代码就可将表中的数据导出到电子表格中。Option ExplicitPrivate Sub Command1_Click()
        Dim tempDB As Database
        Dim i As Integer           ' 循环计数器
        Dim j As Integer
        Dim rCount As Long         ' 记录的个数
        Dim xl As Object           ' OLE自动化对象
        Dim Sn As Recordset
        Screen.MousePointer = 11
        Label1.Caption = "打开数据库..."
        Label1.Refresh
        Set tempDB = Workspaces(0).OpenDatabase("Nwind.mdb")
        Label1.Caption = "创建Excel对象..."
        Label1.Refresh
        Set xl = CreateObject("Excel.Sheet.8")
        Label1.Caption = "创建快照型记录集..."
        Label1.Refresh
        Set Sn = tempDB.OpenRecordset("Customers", dbOpenSnapshot)         If Sn.RecordCount > 0 Then
            Label1.Caption = "将字段名添加到电子表格中"
            Label1.Refresh
            For i = 0 To Sn.Fields.Count - 1
                xl.Worksheets(1).cells(1, i + 1).Value = Sn(i).Name
            Next
            Sn.MoveLast
            Sn.MoveFirst
            rCount = Sn.RecordCount
            ' 在记录中循环
            i = 0
            Do While Not Sn.EOF
                Label1.Caption = "Record:" & Str(i + 1) & " of" & _
                Str(rCount)
                Label1.Refresh
                For j = 0 To Sn.Fields.Count - 1
                   ' 加每个字段的值加到工作表中
                   If Sn(j).Type < 11 Then
                      xl.Worksheets(1).cells(i + 2, j + 1).Value = Sn(j)
                   Else
                      ' 处理Memo和LongBinary 类型的字段
                     xl.Worksheets(1).cells(i + 2, j + 1).Value = "Memo or Binary Data"
                   End If
                Next j
                Sn.MoveNext
                i = i + 1
            Loop
            ' 保存工作表
            Label1.Caption = "保存文件..."
            Label1.Refresh
            xl.SaveAs "c:\Customers.XLS"
            '从内存中删除Excel对象
            Label1.Caption = "退出Excel"
            Label1.Refresh
            xl.Application.Quit
         Else
            ' 没有记录
         End If
         ' 清除
         Label1.Caption = "清除对象"
         Label1.Refresh
         Set xl = Nothing
         Set Sn = Nothing
         Set tempDB = Nothing
         Screen.MousePointer = 0  ' 恢复鼠标指针
         Label1.Caption = "Ready"
         Label1.Refresh
      
         
End SubPrivate Sub Form_Load()
    Label1.AutoSize = True
    Label1.Caption = "Ready"
    Label1.Refresh
End Sub