Private Sub GridToExl_Click()
On Error Resume Next
If DataGrid1.Columns.Count = 0 Then
MsgBox "抱歉，没有数据可供打印！", vbOKOnly, "提示"
Exit Sub
End If
Set cnn = New ADODB.Connection
cnn.Open Adodc1.ConnectionString
‘获取DataGrid数据源
Dim rss As New ADODB.Recordset
rss.CursorLocation = adUseClient
rss.Open Adodc1.RecordSource, cnn, adOpenKeyset, adLockReadOnly
Dim R As Integer, c As Integer
Dim newxls As Excel.Application
Dim newbook As Excel.Workbook
Dim newsheet As Excel.Worksheet
Set newxls = CreateObject("Excel.Application") ‘创建excel应用程序,打开excel2000
Set newbook = newxls.Workbooks.Add ‘创建工作簿
Set newsheet = newbook.Worksheets(1) ‘创建工作表
newxls.Visible = True
‘指定数据标题
For i = 0 To DataGrid1.Columns.Count - 1
newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
Next i
‘将 游标 移至顶行
If Not rss.EOF Then
rss.MoveFirst
End If
If rss.RecordCount > 0 Then
‘复制字段名
For i = 1 To rss.Fields.Count
newsheet.Cells(1, i) = rss.Fields(i - 1).Name
Next i
‘复制全部数据
newsheet.Range("A2").CopyFromRecordset rss
‘设置工作表格式
newsheet.Cells.Font.Size = 10
newsheet.Columns.AutoFit
End If
‘ 首行标题 格式设置
With newxls.Range("A1:H1")
With .Font
.Size = 10
.Bold = True
End With
End With
With newxls
.Range("A1:H1").Select
With .Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
End With
End With
newxls.ActiveSheet.Columns(9).Delete
newxls.ActiveSheet.Columns(2).Delete
With newsheet
‘ .Columns("I:I").Select
‘ Selection.Delete
‘ .Columns("B:B").Select
‘ Selection.Delete
.Columns("A:A").ColumnWidth = 15
End With
Set newxls = Nothing
Set newbook = Nothing
Set newsheet = Nothing
‘关闭记录集及数据库连接，并释放变量
rss.Close
Set rss = Nothing
End Sub