您所在位置：主题：高手请进,怎么解决导出报表的这个问题
xxdzy520
[专家分：0] 发布于 2008-04-30 15:59:00
导出的源代码是这样的
Option Explicit
Public strfilepath As String
Private Sub cmdcancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdok_Click()
Dim i As Integer
Dim rsobj As New ADODB.Recordset
Dim sql As String
Dim firstday As String
Dim days As Integer
Dim lastday As String
Dim oexcel As Object
Dim obook As Object
Dim osheet As Object
On Error GoTo command1_click_error
If Me.textfilepath = "" Then
MsgBox "请选择文件保存位置", vbOKOnly + vbExclamation, "提示"
Else
firstday = Year(Date) & "-" & Me.commonth.Text & "-1"
days = DateDiff("d", Year(Date) & "-" & Me.commonth.Text & "-1", _
Year(Date) & "-" & Me.commonth.Text + 1 & "-1")
lastday = Year(Date) & "-" & Me.commonth.Text & "-" & days
sql = "select * from salarystatistics where yearmonth between #"
sql = sql & firstday & "# and #" & lastday & "#"
Set rsobj = getrs(sql, "salary")
MsgBox iflag & " " & rsobj.GetRows
If rsobj.EOF = False Then '判断是否有统计记录
Set oexcel = CreateObject("Excel.application")
Set obook = oexcel.Workbooks.add
Set osheet = obook.Worksheets(1)
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1")
osheet.Range("a1:l1").Select '设置单元格
With oexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
oexcel.Selection.Merge '设置标题
osheet.Range("a1:l1").Select
oexcel.ActiveCell.FormulaR1C1 = Format(Date, "yyyy" _
) & "年" & Me.commonth.Text & "月工资统计记录"
With oexcel.ActiveCell.Characters(Start:=1, Length:=26).Font
.Name = "宋体"
.FontStyle = "加粗"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1") '设置表格
osheet.Cells(2, 1).Value = "编号"
osheet.Cells(2, 2).Value = "姓名"
osheet.Cells(2, 3).Value = "日期"
osheet.Cells(2, 4).Value = "基本工资"
osheet.Cells(2, 5).Value = "奖金"
osheet.Cells(2, 6).Value = "福利"
osheet.Cells(2, 7).Value = "津贴"
osheet.Cells(2, 8).Value = "扣发"
osheet.Cells(2, 9).Value = "加班费"
osheet.Cells(2, 10).Value = "出差费"
osheet.Cells(2, 11).Value = "其他"
osheet.Cells(2, 12).Value = "总计"
osheet.Columns("A:A").ColumnWidth = 8 '设置表格宽度
osheet.Columns("B:B").ColumnWidth = 6
osheet.Columns("C:C").ColumnWidth = 8
osheet.Columns("D:D").ColumnWidth = 8
osheet.Columns("E:E").ColumnWidth = 4
osheet.Columns("F:F").ColumnWidth = 4
osheet.Columns("G:G").ColumnWidth = 4
osheet.Columns("H:H").ColumnWidth = 4
osheet.Columns("I:I").ColumnWidth = 6
osheet.Columns("J:J").ColumnWidth = 6
osheet.Columns("K:K").ColumnWidth = 4
osheet.Columns("L:L").ColumnWidth = 6
rsobj.MoveFirst
For i = 3 To rsobj.RecordCount + 2 '显示信息
osheet.Cells(i, 1).Value = rsobj(1)
osheet.Cells(i, 2).Value = rsobj(2)
osheet.Cells(i, 3).Value = Format(rsobj(3), "yyyy-mm")
osheet.Cells(i, 4).Value = rsobj(4)
osheet.Cells(i, 5).Value = rsobj(5)
osheet.Cells(i, 6).Value = rsobj(6)
osheet.Cells(i, 7).Value = rsobj(7)
osheet.Cells(i, 8).Value = Format(rsobj(8) + rsobj(9) + rsobj(10), "####")
osheet.Cells(i, 9).Value = rsobj(11)
osheet.Cells(i, 10).Value = rsobj(12)
osheet.Cells(i, 11).Value = rsobj(13)
osheet.Cells(i, 12).Value = Format(rsobj(14), "####")
rsobj.MoveNext
Next i
With osheet '设置边框
.Range(.Cells(1, 1), .Cells(rsobj.RecordCount + 2, 12)).Borders.LineStyle = xlContinuous
End With
obook.SaveAs strfilepath '保存文件
If MsgBox("是否转到导出的Excel文件？", vbOKCancel) = vbOK Then
Unload Me
oexcel.Visible = True
Else
MsgBox "已经成功导出记录！", vbOKOnly + vbExclamation, "提示！"
Unload Me
End If
Exit Sub
Else
MsgBox "数据库中没有选择月份记录！", vbOKOnly + vbExclamation, "提示！"
Me.ZOrder 0
End If
End If
command1_click_error:
Exit Sub
End Sub
Private Sub cmdpath_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.Filter = "All Files (*.*)|*.*|Excel Files" & _
"(*.xls)|*.xls"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowSave
Me.textfilepath = CommonDialog1.FileName
strfilepath = CommonDialog1.FileName
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 12
Me.commonth.AddItem i
Next i
Me.commonth.ListIndex = 0
Me.textfilepath = ""
End Sub
可是单我选了另存为之后就什么也点不出来了,报表也导不出来,是什么问题,该怎么改正才可以??
Option Explicit
Public strfilepath As String
Private Sub cmdcancel_Click()
Unload Me
Exit Sub
End Sub
Private Sub cmdok_Click()
Dim i As Integer
Dim rsobj As New ADODB.Recordset
Dim sql As String
Dim firstday As String
Dim days As Integer
Dim lastday As String
Dim oexcel As Object
Dim obook As Object
Dim osheet As Object
On Error GoTo command1_click_error
If Me.textfilepath = "" Then
MsgBox "请选择文件保存位置", vbOKOnly + vbExclamation, "提示"
Else
firstday = Year(Date) & "-" & Me.commonth.Text & "-1"
days = DateDiff("d", Year(Date) & "-" & Me.commonth.Text & "-1", _
Year(Date) & "-" & Me.commonth.Text + 1 & "-1")
lastday = Year(Date) & "-" & Me.commonth.Text & "-" & days
sql = "select * from salarystatistics where yearmonth between #"
sql = sql & firstday & "# and #" & lastday & "#"
Set rsobj = getrs(sql, "salary")
MsgBox iflag & " " & rsobj.GetRows
If rsobj.EOF = False Then '判断是否有统计记录
Set oexcel = CreateObject("Excel.application")
Set obook = oexcel.Workbooks.add
Set osheet = obook.Worksheets(1)
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1")
osheet.Range("a1:l1").Select '设置单元格
With oexcel.Selection
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlBottom
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.MergeCells = False
End With
oexcel.Selection.Merge '设置标题
osheet.Range("a1:l1").Select
oexcel.ActiveCell.FormulaR1C1 = Format(Date, "yyyy" _
) & "年" & Me.commonth.Text & "月工资统计记录"
With oexcel.ActiveCell.Characters(Start:=1, Length:=26).Font
.Name = "宋体"
.FontStyle = "加粗"
.Size = 18
.Strikethrough = False
.Superscript = False
.Subscript = False
.OutlineFont = False
.Shadow = False
.Underline = xlUnderlineStyleNone
.ColorIndex = xlAutomatic
End With
Set osheet = oexcel.Application.Workbooks(1).Worksheets("sheet1") '设置表格
osheet.Cells(2, 1).Value = "编号"
osheet.Cells(2, 2).Value = "姓名"
osheet.Cells(2, 3).Value = "日期"
osheet.Cells(2, 4).Value = "基本工资"
osheet.Cells(2, 5).Value = "奖金"
osheet.Cells(2, 6).Value = "福利"
osheet.Cells(2, 7).Value = "津贴"
osheet.Cells(2, 8).Value = "扣发"
osheet.Cells(2, 9).Value = "加班费"
osheet.Cells(2, 10).Value = "出差费"
osheet.Cells(2, 11).Value = "其他"
osheet.Cells(2, 12).Value = "总计"
osheet.Columns("A:A").ColumnWidth = 8 '设置表格宽度
osheet.Columns("B:B").ColumnWidth = 6
osheet.Columns("C:C").ColumnWidth = 8
osheet.Columns("D:D").ColumnWidth = 8
osheet.Columns("E:E").ColumnWidth = 4
osheet.Columns("F:F").ColumnWidth = 4
osheet.Columns("G:G").ColumnWidth = 4
osheet.Columns("H:H").ColumnWidth = 4
osheet.Columns("I:I").ColumnWidth = 6
osheet.Columns("J:J").ColumnWidth = 6
osheet.Columns("K:K").ColumnWidth = 4
osheet.Columns("L:L").ColumnWidth = 6
rsobj.MoveFirst
For i = 3 To rsobj.RecordCount + 2 '显示信息
osheet.Cells(i, 1).Value = rsobj(1)
osheet.Cells(i, 2).Value = rsobj(2)
osheet.Cells(i, 3).Value = Format(rsobj(3), "yyyy-mm")
osheet.Cells(i, 4).Value = rsobj(4)
osheet.Cells(i, 5).Value = rsobj(5)
osheet.Cells(i, 6).Value = rsobj(6)
osheet.Cells(i, 7).Value = rsobj(7)
osheet.Cells(i, 8).Value = Format(rsobj(8) + rsobj(9) + rsobj(10), "####")
osheet.Cells(i, 9).Value = rsobj(11)
osheet.Cells(i, 10).Value = rsobj(12)
osheet.Cells(i, 11).Value = rsobj(13)
osheet.Cells(i, 12).Value = Format(rsobj(14), "####")
rsobj.MoveNext
Next i
With osheet '设置边框
.Range(.Cells(1, 1), .Cells(rsobj.RecordCount + 2, 12)).Borders.LineStyle = xlContinuous
End With
obook.SaveAs strfilepath '保存文件
If MsgBox("是否转到导出的Excel文件？", vbOKCancel) = vbOK Then
Unload Me
oexcel.Visible = True
Else
MsgBox "已经成功导出记录！", vbOKOnly + vbExclamation, "提示！"
Unload Me
End If
Exit Sub
Else
MsgBox "数据库中没有选择月份记录！", vbOKOnly + vbExclamation, "提示！"
Me.ZOrder 0
End If
End If
command1_click_error:
Exit Sub
End Sub
Private Sub cmdpath_Click()
CommonDialog1.CancelError = True
On Error GoTo errhandler
CommonDialog1.Flags = cdlOFNHideReadOnly
CommonDialog1.Filter = "All Files (*.*)|*.*|Excel Files" & _
"(*.xls)|*.xls"
CommonDialog1.FilterIndex = 2
CommonDialog1.ShowSave
Me.textfilepath = CommonDialog1.FileName
strfilepath = CommonDialog1.FileName
Exit Sub
errhandler:
Exit Sub
End Sub
Private Sub Form_Load()
Dim i As Integer
For i = 1 To 12
Me.commonth.AddItem i
Next i
Me.commonth.ListIndex = 0
Me.textfilepath = ""
End Sub
可是单我选了另存为之后就什么也点不出来了,报表也导不出来,是什么问题,该怎么改正才可以??