
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个回答
展开全部
还涉及到ADODB.Recordset, Microsoft ActiveX Data Objects引用了没有?

2023-05-10 广告
您好!建议咨 深圳市微测检测有限公司,已建立起十余个专业实验室,企业通过微测检测就可以获得一站式的测试与认 证解决方案;(EMC、RF、MFi、BQB、QI、USB、安全、锂电池、快充、汽车电子EMC、汽车手机互 联、语音通话质量),认证遇...
点击进入详情页
本回答由微测检测5.10提供
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询