大理石漆:VB问题,恳请各路高手救急!!!
我做的VB中的一个Sub
ColNum是列数
RowNum是行数
调用是用Call CreatExl(0)
参考一下吧,直接用的话可能会有些问题
'生产Excel表格文件
Public Sub CreatExl(ByVal TuBiao As Boolean)
On Error GoTo ErroChannal
If TuBiao = False Then
CommonDialog1.DialogTitle = "保存数据"
CommonDialog1.Filter = "*.xls"
CommonDialog1.ShowSave
End If
Set Exl = GetObject("", "Excel.Application")
'Exl.Visible = True
Exl.Workbooks.Add
Set vbsheet = Exl.ActiveSheet
Dim Rrow As Integer
Dim Ccol As Integer
For Ccol = 1 To ColNum '添加表头
vbsheet.Cells(1, Ccol) = DataGrid1.Columns(Ccol - 1).Caption
Next Ccol
For Ccol = 1 To ColNum '添加表头
For Rrow = 1 To RowNum
vbsheet.Cells(Rrow + 1, Ccol) = DataGrid1.Columns(Ccol - 1).CellText(DataGrid1.FirstRow + Rrow - 1)
Next Rrow
Next Ccol
vbsheet.Cells.ColumnWidth = 15 '表格的一些设置
vbsheet.Cells.HorizontalAlignment = xlLeft
If CbHow.ListIndex > 1 Then vbsheet.Columns("A:A").NumberFormatLocal = "yyyy-mm-dd"
'设置文件名
ExlTitle = ExlTitle & CbWhat.Text & CbHow.Text
If CbHow.ListIndex = 0 Then
If CbTime.Text = "全部" Then
ExlTitle = ExlTitle & CbTime.List(1) & "~" & CbTime.List(CbTime.ListCount - 1)
ElseIf CbTime.ListIndex > 0 Then
ExlTitle = ExlTitle & CbTime.Text
End If
ElseIf CbHow.ListIndex > 0 Then
If CbYear.Text = "全部" Then
If CbTime.Text = "全部" Then
ExlTitle = ExlTitle & CbYear.List(1) & "~" & CbYear.List(CbYear.ListCount - 1)
ElseIf CbTime.ListIndex > 0 Then
ExlTitle = ExlTitle & CbTime.Text
End If
ElseIf CbYear.ListIndex > 0 Then
ExlTitle = ExlTitle & CbYear.Text
End If
End If
If TuBiao = False Then
Exl.ActiveWorkbook.SaveAs CommonDialog1.FileName '保存文件
Exl.ActiveWorkbook.Close
Exl.Quit
Set Exl = Nothing
MsgBox "数据成功导出!", 0 + 64 + 0, "恭喜"
End If
ErroChannal:
Exit Sub
End Sub
SORRY 现在不方便,37191520,有问题的话可以联系,我这里有这种代码,而且很简单。