表格数据输出到Excel中

Sub ImpExcel(GRid As Object, n As Integer)
  Dim xlApp As Excel.Application
  Dim i, j, r, file1, ob1
  file1 = App.Path & "/xhdn/项目分类查询统计" & Date & ".xls"
 FileCopy "xhdn/xh01.xls", file1
 DoEvents
  Set xlApp = New Excel.Application
  Set xlApp = CreateObject("Excel.Application")
 '激活EXCEL应用程序
 xlApp.Visible = False '隐藏EXCEL应用程序窗口
 
 Set xlBook = xlApp.Workbooks.Open(file1)
 '打开工作簿，strDestination为一个EXCEL报表文件
 Set xlSheet = xlBook.Worksheets(1)
 'xlsheet.range("G12").Select
 'xlsheet.Pictures.Insert("C:/01.gif").Select   图像文件处理
 'xlApp.Selection.ShapeRange.ScaleWidth 2.76, msoFalse, msoScaleFromTopLeft
 'xlApp.Selection.ShapeRange.ScaleHeight 2.77, msoFalse, msoScaleFromTopLeft
 
  xlSheet.Cells(2, 1) = P_setup1(6) & "项目分类查询统计"
  xlSheet.Cells(4, 1) = "制表日期:" & Date
   ob1 = ""
With GRid
    For i = 1 To GRid.Rows - 1
       If ob <> .TextMatrix(i, 1) Then   '重复数据处理
         xlSheet.Cells(5 + i, 1) = .TextMatrix(i, 1)
         ob = .TextMatrix(i, 1)
       Else
         xlSheet.Cells(5 + i, 1).Borders(xlEdgeTop).LineStyle = xlNone   '线型处理
         xlSheet.Cells(5 + i, 1).Borders(xlEdgeBottom).LineStyle = xlNone
       End If
     For j = 2 To 4
       xlSheet.Cells(5 + i, j) = .TextMatrix(i, j)
      Next j
      If .TextMatrix(i, 1) = "合计：" Then
       r = "A" & 5 + i & ":D" & 5 + i
       With xlSheet.Range(r).Interior
        .ColorIndex = 15
        .Pattern = xlSolid
      End With
      End If
      xlSheet.Cells(5 + i + 1, j).EntireRow.Insert
       r = "A" & 5 + i + 1 & ":D" & 5 + i + 1
        xlSheet.Range(r).Interior.ColorIndex = xlNone
    Next i
 End With
 
   If n = 1 Then
    
      'xlsheet.PrintPreview = False
      xlSheet.PrintOut
      xlBook.Save
      xlApp.Quit
    Else
       xlApp.Visible = True
    End If
   Set xlApp = Nothing
  
    
    
End Sub