如何在VB的窗体中显示Excel报表
发布网友
发布时间：2022-04-23 09:38
共1个回答
热心网友
时间：2022-04-12 16:12
Option Explicit
Public xlApp As New Excel.Application
Public xlBook As Excel.Workbook
Public xlSheet As Excel.Worksheet
Public Function SaveAsExcel(rsErr As ADODB.Recordset, sFileName As String, _
sSheet As String, sOpen As String, ByVal field As String)
Dim fd As field
Dim CellCnt As Integer
Dim i As Integer
Dim fieldArr() As String
Dim t As Integer
fieldArr = Split(field, "|")
On Error GoTo Err_Handler
Screen.MousePointer = vbHourglass
Set xlApp = New Excel.Application
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets.Add
'获取字段名
CellCnt = 1
xlSheet.name = sSheet
For Each fd In rsErr.Fields '添加listview标题
xlSheet.Cells(1, CellCnt).value = fieldArr(CellCnt - 1)
xlSheet.Cells(1, CellCnt).Interior.ColorIndex = 33
xlSheet.Cells(1, CellCnt).Font.Bold = True
xlSheet.Cells(1, CellCnt).BorderAround xlContinuous
CellCnt = CellCnt + 1
Next
rsErr.MoveFirst
i = 2
t = 1
Do While Not rsErr.EOF()
CellCnt = 1
For Each fd In rsErr.Fields
If fd.name = "Company_Id" Or fd.name = "Drugs_Id" Then
xlSheet.Cells(i, CellCnt).value = t
Else
xlSheet.Cells(i, CellCnt).NumberFormat = "@"
xlSheet.Cells(i, CellCnt).value = rsErr.Fields(fd.name).value
End If
CellCnt = CellCnt + 1
Next
rsErr.MoveNext
i = i + 1
t = t + 1
Loop
'自动填充
CellCnt = 1
For Each fd In rsErr.Fields
xlSheet.Columns(CellCnt).AutoFit
CellCnt = CellCnt + 1
Next
xlSheet.SaveAs sFileName ' 保存 Worksheet.
xlBook.Close ' 关闭 Workbook
xlApp.Quit ' 关闭 Excel
If sOpen = "YES" Then ' 打开 Excel Workbook
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Open(sFileName)
Set xlSheet = xlBook.Worksheets(1)
xlSheet.Application.Visible = True
Else
Set xlApp = Nothing '释放 Excel 对象.
Set xlBook = Nothing
Set xlSheet = Nothing
End If
Err_Handler:
If Err = 0 Then
Screen.MousePointer = vbDefault
Else
MsgBox "未知错误！ " & vbCrLf & vbCrLf & Err & ":" & Error & " ", vbExclamation
Screen.MousePointer = vbDefault
End If
End Function
