Option Explicit
Dim objApp As Object
Dim objBook As Object
Dim objSheet As Excel.Worksheet

Private Sub CmdExcel_Click()
If PrintFlat = True Then
     On Error Resume Next
     Set objApp = GetObject(, "Excel.Application")
     '若Excel 没有启动
     If Err = 429 Then
     Err = 0
     Set objApp = CreateObject("Excel.Application")
     '无法创建Excel对象
     If Err = 429 Then
     MsgBox Err & ": " & Error, vbExclamation + vbOKOnly
     Exit Sub
     End If
     End If
     Set objBook = objApp.Workbooks.Add
     Set objSheet = objBook.Worksheets(1)
     Set objSheet = objBook.Worksheets(1) '打开EXCEL工作表
     objSheet.Activate '激活工作表
     'Set objBook = objApp.Workbooks.Open("c:\temp\bb.xls") '打开EXCEL工作簿
    ' objBook.RunAutoMacros (xlAutoOpen) '运行EXCEL中的启动宏
     If Option1(0).Value = True Then
     ResidualName = "余额金额"
     Else
     ResidualName = "余额次数"
     End If
     myExcel  
     PrintFlat = False
With objBook
    '    .Title = Date & ResidualName
         .Subject = ResidualName
         .SaveAs FileName:=Year(Date) & Month(Date) & Day(Date) & Hour(Time) & Minute(Time) & Second(Time) & ResidualName & ".xls"
          '.SaveAs FileName:="C:\tmp\book1.xls"
       End With

      objApp.Visible = True ' False 让excel 可见
      objApp.Interactive = True
      objApp.DisplayAlerts = False

      'objBook.Close SaveChanges:=False 关闭工作簿
'      On Error Resume Next
'      objBook.Close
'      objApp.Quit '结束EXCEL对象
       If Not (objBook Is Nothing) Then
          Set objBook = Nothing
       End If
       If Not (objSheet Is Nothing) Then
          Set objSheet = Nothing
       End If
       If Not (objApp Is Nothing) Then
          Set objApp = Nothing
        End If
'      Set objBook = Nothing
'      Set objSheet = Nothing
'      Set objApp = Nothing '释放xlApp对象
'  End If
'    End If

Else
  MsgBox "请先执行查询！", 48, "错误"
  Exit Sub
End If
End Sub
'excel
Sub myExcel()
    Dim i As Integer, j As Integer
    'Dim intColumn As Integer
' Macro2 Macro
' 宏由 zhangxiang 录制，时间: 2006-9-30
    'Range("A1:E11").Select
    'On Error Resume Next

    Range("C1:E1").Select
    With Selection
        .HorizontalAlignment = xlCenter
        .VerticalAlignment = xlCenter
        .WrapText = False
        .Orientation = 0
        .AddIndent = False
        .IndentLevel = 0
        .ShrinkToFit = False
        .ReadingOrder = xlContext
        .MergeCells = False
    End With
    Selection.Merge
    Range("D1:F1").Select
    ActiveCell.FormulaR1C1 = ResidualName & "统计报表"
   
   
    Range("A3").Select
    ActiveCell.FormulaR1C1 = "卡号"
    Selection.HorizontalAlignment = xlCenter
   
    Range("B3").Select
    ActiveCell.FormulaR1C1 = "编号"
    Selection.HorizontalAlignment = xlCenter
   
    Range("C3").Select
    ActiveCell.FormulaR1C1 = "用户姓名"
    Selection.HorizontalAlignment = xlCenter
   
    Range("D3").Select
    ActiveCell.FormulaR1C1 = "工作单位"
    Selection.HorizontalAlignment = xlCenter
   
    Range("E3").Select
    ActiveCell.FormulaR1C1 = "所属部门"
    Selection.HorizontalAlignment = xlCenter
   
    Range("F3").Select
    ActiveCell.FormulaR1C1 = "开户日期"
    Selection.HorizontalAlignment = xlCenter
   
    Range("G3").Select
    ActiveCell.FormulaR1C1 = ResidualName
    Selection.HorizontalAlignment = xlCenter
   
    i = 4
    'intColumn = DataMoney.Recordset.Count
    Do While Not RS.EOF
         Range("A" & i).Select
         If Not IsNull(RS.Fields(0).Value) Then
            Columns("A:A").ColumnWidth = 10
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(0).Value)
         End If
        
         Range("B" & i).Select
         If Not IsNull(RS.Fields(1).Value) Then
            Columns("B:B").ColumnWidth = 10
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(1).Value)
         End If
        
         Range("C" & i).Select
         If Not IsNull(RS.Fields(2).Value) Then
            Columns("C:C").ColumnWidth = 10
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(2).Value)
         End If
        
         Range("D" & i).Select
         If Not IsNull(RS.Fields(3).Value) Then
            Columns("D:D").ColumnWidth = 12
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(3).Value)
         End If
        
         Range("E" & i).Select
         If Not IsNull(RS.Fields(4).Value) Then
            Columns("E:E").ColumnWidth = 12
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(4).Value)
         End If
        
         Range("F" & i).Select
         If Not IsNull(RS.Fields(5).Value) Then
            Columns("F:F").ColumnWidth = 12
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(5).Value)
         End If
        
         Range("G" & i).Select
         If Not IsNull(RS.Fields(6).Value) Then
            Columns("G:G").ColumnWidth = 10
            Selection.HorizontalAlignment = xlCenter
            ActiveCell.FormulaR1C1 = CStr(RS.Fields(6).Value)
         End If
      'Next
      'Sums = Sums + RS.Fields(6)
      RS.MoveNext
      i = i + 1
    Loop
    '表格边框线
    Dim TableBorder As String
    TableBorder = "A3:" & "G" & RS.RecordCount + 3
    Range(TableBorder).Borders.LineStyle = xlContinuous
   
'    If Not IsNull(Sums) Then
'       Range("F" & RS.RecordCount + 5).Select
'       Selection.HorizontalAlignment = xlCenter
'       ActiveCell.FormulaR1C1 = PayName & "和"
'
'       Range("G" & RS.RecordCount + 5).Select
'       Selection.HorizontalAlignment = xlCenter
'       ActiveCell.FormulaR1C1 = CStr(Sums) & "元"
'    End If

End Sub