表格数据输出到Excel中

最新推荐文章于 2025-07-19 11:35:29 发布

原创最新推荐文章于 2025-07-19 11:35:29 发布 · 置顶 · 1.3k 阅读

0 ·

CC 4.0 BY-SA版权

文章标签：

#excel #file #integer #date #object #报表

本文介绍了一段使用VBA从Grid对象导出数据到Excel并进行格式化的代码实现过程。该过程包括设置Excel文件路径、复制模板文件、创建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