'用Excel作报表Private Sub Toolbar1_ButtonClick(ByVal Button As MSComctlLib.Button)
  Select Case Button.Index
  Case 1
'      SSPanel2.Visible = True
'      probar.Value = 0
'      Dim myexcel As New Excel.Application, I, J, K As Integer, col As String
'      With myexcel
'          On Error GoTo excle
'          .Application.Visible = False
'          .Workbooks.Add
'      '***********画字段************
'          J = 0
'      'example: b2 ----g2 ’列 本程序从b列,和第2行开始
'          For I = 66 To (66 + Rs_temp.Fields.Count - 1) '从rs中头一个字段到最后一个
'            col = Chr(I) & "2" 'chr(66)就是b
'            Range(col).Select
'            ActiveCell.FormulaR1C1 = Rs_temp.Fields(J).Name '
'            J = J + 1
'          Next I
'      '*************以先横后竖顺序画表***************
'          K = 0
'          Rs_temp.MoveFirst
'          DoEvents
'          For J = 3 To 3 + Rs_temp.RecordCount '本程序从b3开始,所以用3
'            K = 0
'            For I = 66 To (66 + Rs_temp.Fields.Count - 1)
'              col = Chr(I) & CStr(J) '得到目标表格的值如 c3
'              Range(col).Select
'              ActiveCell.FormulaR1C1 = Rs_temp.Fields(K)
'              K = K + 1
'            Next I
'            On Error Resume Next
'            probar.Value = probar.Value + 1
'            Rs_temp.MoveNext
'            If Rs_temp.EOF = True Then
'              SSPanel2.Visible = False
'              .Application.Visible = True
'            End If
'          Next J
'      End With
'excle:
'    MsgBox ("您没有安装excle2000,请先安装excel2000")
    
    Dim Irow, Icol As Integer
    Dim Irowcount, Icolcount As Integer
    Dim Fieldlen1 As Integer
    '存字段长度值
    Dim Fieldlen()
    'Dim xlApp As Excel.Application
    'Dim xlBook As Excel.Workbook
    'Dim xlSheet As Excel.Worksheet    Set xlApp = CreateObject("Excel.Application")
    Set xlBook = xlApp.Workbooks.Add
    Set xlSheet = xlBook.Worksheets(1)    SSPanel2.Visible = True
    probar.Value = 0    'On Error GoTo excle
    With Rs_temp
        .MoveLast        If .RecordCount < 1 Then
            MsgBox ("没有记录!")
            Exit Sub
        End If        '记录总数
        Irowcount = .RecordCount
        '字段总数
        Icolcount = .Fields.Count        ReDim Fieldlen(Icolcount)
        .MoveFirst        For Irow = 1 To Irowcount + 1
            
            For Icol = 1 To Icolcount
                Select Case Irow
                    '在Excel中的第一行加标题
                    Case 1
                        xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1).Name
                    '将数组FIELDLEN()存为第一条记录的字段长
                    Case 2
                        If IsNull(.Fields(Icol - 1)) = True Then
                            Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
                        '如果字段值为NULL,则将数组Filelen(Icol)的值设为标题名的宽度
                        Else
                            Fieldlen(Icol) = LenB(.Fields(Icol - 1))
                        End If                        xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
                        'Excel列宽等于字段长
                        xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
                        '向Excel的CellS中写入字段值
                    Case Else
                        If IsNull(.Fields(Icol - 1)) Then
                            Fieldlen(Icol) = LenB(.Fields(Icol - 1).Name)
                        Else
                            Fieldlen1 = LenB(.Fields(Icol - 1))
                        End If                        If Fieldlen(Icol) < Fieldlen1 Then
                            xlSheet.Columns(Icol).ColumnWidth = IIf(Fieldlen1 > 255, 255, Fieldlen1)
                            '表格列宽等于较长字段长
                            Fieldlen(Icol) = IIf(Fieldlen1 > 255, 255, Fieldlen1)
                            '数组Fieldlen(Icol)中存放最大字段长度值
                        Else
                            xlSheet.Columns(Icol).ColumnWidth = Fieldlen(Icol)
                        End If                        xlSheet.Cells(Irow, Icol).Value = .Fields(Icol - 1)
                End Select
            Next            If Irow > 2 Then
              If Not .EOF Then .MoveNext
            End If
            
            If Not .EOF Then
              If Irow < Irowcount Then
                probar.Value = probar.Value + 1
              End If
            End If
        
        Next        '网格线
        With xlSheet
            .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Name = "黑体"
            '设标题为黑体字
            .Range(.Cells(1, 1), .Cells(1, Icol - 1)).Font.Bold = True
            '标题字体加粗
            .Range(.Cells(1, 1), .Cells(Irow, Icol - 1)).Borders.LineStyle = xlContinuous
            '设表格边框样式
        End With        '*!* 页眉、填报单位、报表时间、单位
        With xlSheet.PageSetup
            .LeftHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10公司名称:"   ' & Gsmc
            .CenterHeader = "&""楷体_GB2312,常规""业务数据综合查询表&""宋体,常规""" & Chr(10) & "&""楷体_GB2312,常规""&10日 期:"
            .RightHeader = "" & Chr(10) & "&""楷体_GB2312,常规""&10单位:"
            .LeftFooter = "&""楷体_GB2312,常规""&10制表人:"
            .CenterFooter = "&""楷体_GB2312,常规""&10制表日期:"
            .RightFooter = "&""楷体_GB2312,常规""&10第&P页 共&N页"
        End With        '显示表格
        Dim ExclFileName As String
        ExclFileName = App.path & "\业务数据综合查询表.xls"
        If Dir(ExclFileName) <> "" Then
            Kill ExclFileName
        End If
        xlSheet.SaveAs (ExclFileName)
        SSPanel2.Visible = False
        xlApp.Application.Visible = True
        '交还控制给Excel
        'xlSheet.PrintPreview
        'xlApp.Quit
    End With
'excle:
'    MsgBox ("您没有安装 Excle2000,请先安装 Excel2000 !")
  Case 2
    Unload Me
  End Select
End Sub