[] 帮忙看一段Datagrid导出到Excel的代码

[求助] 帮忙看一段Datagrid导出到Excel的代码
本帖最后由 iamggggs 于 2012-04-01 16:01:57 编辑

Private Sub out_Click()

Dim i, j, k As Integer
Dim xlapp As Variant
Dim xlBook As Variant
Dim xlSHEET As Variant
AD_report.Refresh

Set xlapp = CreateObject("excel.application")
Set xlBook = xlapp.Workbooks.Add
Set xlSHEET = xlBook.Worksheets(1)
xlapp.Visible = True

On Error Resume Next
If Err.Number <> 0 Then Set xlapp = CreateObject("Excel.Application")
Set xlBook = xlapp.Workbooks.Add
Set xlSHEET = xlBook.ActiveSheet

For k = 1 To DataGrid1.Columns.Count
xlSHEET.Cells(2, k) = DataGrid1.Columns(k - 1).Caption
Next k
For i = 2 To AD_report.Recordset.RecordCount + 1
For j = 0 To DataGrid1.Columns.Count
xlSHEET.Cells(i + 1, j + 1) = "'" & AD_report.Recordset(j) '

Next j
AD_report.Recordset.MoveNext
Next i

xlSHEET.Range(Cells(1, 1), Cells(1, DataGrid1.Columns.Count)).Merge    '第一行各列合并
xlSHEET.Cells(1, 1) = DataGrid1.Caption
xlSHEET.Cells.HorizontalAlignment = xlCenter     '居中显示
xlSHEET.Cells.VerticalAlignment = xlCenter       '居中显示
xlSHEET.Range(xlSHEET.Cells(1, 1), xlSHEET.Cells(1, DataGrid1.Columns.Count)).Interior.Color = RGB(211, 211, 211) '标题栏底色浅灰
xlSHEET.Cells.EntireColumn.AutoFit  ' 自适应列宽
xlSHEET.Range(xlSHEET.Cells(2, 1), xlSHEET.Cells(i, DataGrid1.Columns.Count)).Borders.LineStyle = xlContinuous '表格画边框
    
'释放excel相应变量
Set xlSHEET = Nothing
Set xlBook = Nothing
Set xlapp = Nothing

AD_report.Refresh
End Sub

主要是第一行合并列的问题：第一次执行后导出表格，标题栏合并正常，表格内容显示正常，但如果关闭excel表，再次点击导出，则表格内容正常，但第一行各列不再合并，需手工调整，是哪里出了问题？
[解决办法]
不要使用On Error Resume Next，使用之，在哪出错你都不知道，看你的代码err.number<>0 的代码应该都不会为你创建excel对象，反而是掩盖了后面代码可能的错误

我觉得，一般使用On Error goto errhandler是处理错误更好的办法


[解决办法]

引用:

不要使用On Error Resume Next，使用之，在哪出错你都不知道，看你的代码err.number<>0 的代码应该都不会为你创建excel对象，反而是掩盖了后面代码可能的错误

我觉得，一般使用On Error goto errhandler是处理错误更好的办法

这不是重点吧？现在的问题是第一次执行的时候完全正常，第二次执行则合并列操作无效，具体说就是这句：
[code]xlSHEET.Range(Cells(1, 1), Cells(1, DataGrid1.Columns.Count)).Merge [/code]
[解决办法]

xlSHEET.Range(Cells(1, 1), Cells(1, DataGrid1.Columns.Count)).Merge 

这句。

查看更多 下一篇