VB大神看看这段程序哪里有问题,引用了Microsoft excel 15.0 library,还是出现用户定义类型未定义
OptionExplicitPublicxlAppAsNewExcel.ApplicationPublicxlBookAsExcel.WorkbookPublicxlSh...
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
http://zhidao.baidu.com/link?url=D5yWlzAsoUluVgbGkM6mI91EAf-npaaBpQP5r3apbt2144Ezg4jgWv9wzmFKig3z6I4xawumutmBvF8D1Ld0_a,这是这段代码出处
是不是还需要加什么东西?关于定义ADODB.Recordset那一行,具体给解释下谢啦。原来的程序也是不能运行,用户定义类型为定义,我稍微改了点,还是不行 展开
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
http://zhidao.baidu.com/link?url=D5yWlzAsoUluVgbGkM6mI91EAf-npaaBpQP5r3apbt2144Ezg4jgWv9wzmFKig3z6I4xawumutmBvF8D1Ld0_a,这是这段代码出处
是不是还需要加什么东西?关于定义ADODB.Recordset那一行,具体给解释下谢啦。原来的程序也是不能运行,用户定义类型为定义,我稍微改了点,还是不行 展开
1个回答
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询