注册 登录
编程论坛 ACCESS论坛

[求助] 从access中导出excel系统提示编译错误:用户定义类型为定义。把代码发一下

ry200w 发布于 2007-08-12 10:30, 1979 次点击

Option Compare Database
Option Explicit
Public MyXL As Object
Sub GetExcel()
'使用这段代码,可以打开一个Excel实例或者引用已经打开的Excel实例
Const ERR_APP_NOTRUNNING As Long = 429
On Error Resume Next
Set MyXL = GetObject("Excel.Application")
If Err = ERR_APP_NOTRUNNING Then
Set MyXL = New Excel.Application
End If
MyXL.Application.Visible = True
End Sub

Public Sub CreateNewBook()
'新建一个工作簿
MyXL.Application.WorkBooks.Add
End Sub

Public Sub CopyToClip(FormName As String, SubFormName As String)
'使用代码将窗体上的数据复制到Windows粘贴板
Forms(FormName).Controls(SubFormName).SetFocus
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
End Sub

Public Sub CopyToExcel()
'使用代码将Windows粘贴板的内容粘贴到Excel
GetExcel
MyXL.Application.WorkBooks.Add
MyXL.Application.ActiveSheet.Paste
End Sub

Public Sub FormatTAB()
'对导出到Excel中的数据进行格式化,比如,加上报表标题、设置表格线等。
Dim J As Integer
SetLine '设置表格线的子程序,在Access中实现对Excel文档格式化
MyXL.Application.ActiveSheet.Rows("1:1").Select
'插入两行作为标题行
For J = 1 To 2
MyXL.Application.Selection.Insert Shift:=xlDown
Next J
MyXL.Application.ActiveSheet.Range("A1") = "标题文字"
'设置表标题字体
MyXL.Worksheets(1).Range("A1").Select
With MyXL.Application.Selection.Font
.Name = "宋体"
.Size = 16
End With
End Sub

Public Sub SetLine()
'设置表格线
On Error Resume Next
MyXL.Application.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
MyXL.Application.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
MyXL.Application.Selection.WrapText = False
With MyXL.Application.Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With MyXL.Application.Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With MyXL.Application.Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With MyXL.Application.Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With MyXL.Application.Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
With MyXL.Application.Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlHairline
.ColorIndex = xlAutomatic
End With
End Sub

Public Sub CloseExcel()
'关闭打开的工作簿
'关闭Excel
On Error Resume Next
MyXL.Application.DisplayAlerts = False
MyXL.Application.Save
MyXL.Application.quit
Set MyXL = Nothing '释放对该应用程序
End Sub

3 回复
#2
西风独自凉2007-08-13 18:42
是否引用了excel部件。。
#3
ry200w2007-08-13 19:27
谢谢!按照你说的我引用选"Microsoft Excel 1x.0 Library"
在 VBA 编辑器中,[工具]--[引用], 选"Microsoft Excel 1x.0 Library", 点[确定]

问题已经解决!
再次感谢。

[此贴子已经被作者于2007-8-13 19:35:57编辑过]

#4
西风独自凉2007-08-13 20:33
不客气
1