这个问题在CSDN发布几天,竟没有一个人知道如何处理,将此贴发在VBGOOD上,希望网友们帮忙.
用VB导出数据到EXCEL,窗口第一次运行导出的数据格式(自定义字体,合并单元格)正常,第二次\第三次运行窗口进行导出时,竟不能按照自定义格式进行导出.代码如下:
private sub command3_click()
Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Set xlApp = CreateObject("Excel.Application")
On Error Resume Next
Set xlBook = xlApp.Workbooks.add
Set xlSheet = xlBook.Worksheets(1)
xlApp.Visible = False
xlSheet.Activate
If Combo3.Text = "第一季度" And Option2.Value = True Then
'处理数据,填充Excel表
xlSheet.Range(Cells(1, 1), Cells(1, 9)).Merge '合并单元格
xlSheet.Cells(1, 1) = "资金发放明细表"
xlSheet.Range(Cells(1, 1), Cells(1, 9)).Characters.Font.Name = "黑体" '设置标题为黑体,18号
xlSheet.Range(Cells(1, 1), Cells(1, 9)).Characters.Font.Size = 18
xlSheet.Rows.RowHeight = 21
xlSheet.Range(Cells(2, 1), Cells(2, 256)).Characters.Font.Name = "宋体" '设置表头为宋体,10号,加粗
xlSheet.Range(Cells(2, 1), Cells(2, 256)).Characters.Font.Size = 10
xlSheet.Range(Cells(2, 1), Cells(2, 256)).Characters.Font.FontStyle = "加粗"
xlSheet.Range(Cells(3, 1), Cells(65536, 256)).Characters.Font.Name = "宋体" '设置内容为宋体,10号
xlSheet.Range(Cells(3, 1), Cells(65536, 256)).Characters.Font.Size = 10
xlSheet.Range(Cells(1, 1), Cells(65536, 256)).HorizontalAlignment = 3 '设置内容为水平对齐
xlSheet.Range(Cells(1, 1), Cells(65536, 256)).VerticalAlignment = 2 '设置内容为垂直对齐
xlSheet.Cells(2, 1) = "乡名"
xlSheet.Cells(2, 2) = "村名"
xlSheet.Cells(2, 3) = "组名"
xlSheet.Cells(2, 4) = "编号"
xlSheet.Cells(2, 5) = "户主"
xlSheet.Cells(2, 6) = "受益人"
xlSheet.Cells(2, 7) = "金额"
xlSheet.Cells(2, 8) = "资金说明"
xlSheet.Cells(2, 9) = "备注"
i = 3
While Not rs.EOF
xlSheet.Cells(i, 1) = rs.Fields("xming")
xlSheet.Cells(i, 2) = rs.Fields("cming")
xlSheet.Cells(i, 3) = rs.Fields("zming")
xlSheet.Cells(i, 4) = rs.Fields("twbhao")
xlSheet.Cells(i, 5) = rs.Fields("twhzhu")
xlSheet.Cells(i, 6) = rs.Fields("twsyren")
xlSheet.Cells(i, 7) = rs.Fields("je")
xlSheet.Cells(i, 8) = rs.Fields("zjsming")
xlSheet.Cells(i, 9) = rs.Fields("bzhu")
rs.MoveNext
i = i + 1
Wend
End If
xlBook.SaveAs Text1.Text '保存Excel表格
MsgBox "数据导出成功!", vbInformation, systitle
xlApp.Visible = True '显示表格
Set xlApp = Nothing '交还控制给Excel
Set xlBoook = Nothing
Set xlSheet = Nothing
end sub
谢谢!
