将窗体内容导出到Excel并对其进行格式化

时　间:2008-07-23 17:31:39
作　者:UMVsoft整理   ID：43  城市：江阴
摘　要:将窗体内容导出到Excel并对其进行格式化
正　文:

我们开发软件过程中，经常需要将窗体或子窗体的数据导出到Excel，以便进行数据分析、统计或生成图表，所以使用代码自动完成这些操作，就可以得大大提高效率，下面就这个问题，归纳总结一下，希望对大家有所帮助：

一、在Access中使用代码打开Excel：

Public MyXL As Object
'打开Excel
Sub GetExcel()

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
使用这段代码，可以打开一个Excel实例或者引用已经打开的Excel实例

二、新建一个工作簿

Sub CreateNewBook

MyXL.Application.Workbooks.Add
End Sub

三、使用代码将窗体上的数据复制到Windows粘贴板

Sub CopyToClip

Forms(FormName).Controls(SubFormName).SetFocus
DoCmd.RunCommand acCmdSelectAllRecords
DoCmd.RunCommand acCmdCopy
End Sub

四、使用代码将Windows粘贴板的内容粘贴到Excel

Sub CopyToExcel()

GetExcel
MyXL.Application.Workbooks.Add
MyXL.Application.ActiveSheet.Paste
End Sub

五、对导出到Excel中的数据进行格式化，比如，加上报表标题、设置表格线等。

Sub FormatTAB（）

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

'设置表格线
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

六、关闭打开的工作簿

'关闭Excel
Sub CloseExcel()
On Error Resume Next
MyXL.Application.DisplayAlerts = False
MyXL.Application.Save
MyXL.Application.Quit
Set MyXL = Nothing '释放对该应用程序
End Sub
经过上面的讲述，一个完整的导出操作就完成了。