主题:关于VB把数据传到Excel表格的问题!
Private Sub Command1_Click()
Dim i As Integer, 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")
Set newbook = newxls.Workbooks.Add
setnewsheet = newbook.Worksheets(1)
If SQL <> "" Then
Adodc1.RecordSource = SQL
Adodc1.Refresh
End If
If Adodc1.Recordset.RecordCount > 0 Then
For i = 0 To DataGrid1.Columns.Count - 1
newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
Next i
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
r = Adodc1.Recordset.AbsolutePosition
For c = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Col = c
newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
Next c
Adodc1.Recordset.MoveNext
Loop
Dim myval As Long
Dim mustr As String
myval = MsgBox("是否保存该excel表?", vbYesNo, "提示窗口")
If myval = vbYes Then
mystr = InputBox("请输入文件名称", "输入窗口")
If Len(mystr) = 0 Then
MsgBox "系统不允许文件名称为空!", , "提示窗口"
Exit Sub
End If
On Error GoTo errsave
newsheet.SaveAs App.Path & "\excel文件\" & mystr & ".xls"
MsgBox "excel文件保存成功,位置:" & App.Path & "\excel文件\" & mystr & ".xls", , "提示窗口"
newxls.Quit
errsave:
Exit Sub
MsgBox Err.Description, , "提示窗口"
End If
End If
End Sub
传递过去没有显示,报存成功和路径的对话框。但是我打开别的EXCEL表格时能看到这个数据表一闪就没了,关闭这个EXCEL表格时还提示是否保存含有数据的这个表。能帮我调试一下不!谢谢
Dim i As Integer, 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")
Set newbook = newxls.Workbooks.Add
setnewsheet = newbook.Worksheets(1)
If SQL <> "" Then
Adodc1.RecordSource = SQL
Adodc1.Refresh
End If
If Adodc1.Recordset.RecordCount > 0 Then
For i = 0 To DataGrid1.Columns.Count - 1
newsheet.Cells(1, i + 1) = DataGrid1.Columns(i).Caption
Next i
Adodc1.Recordset.MoveFirst
Do Until Adodc1.Recordset.EOF
r = Adodc1.Recordset.AbsolutePosition
For c = 0 To DataGrid1.Columns.Count - 1
DataGrid1.Col = c
newsheet.Cells(r + 1, c + 1) = DataGrid1.Columns(c)
Next c
Adodc1.Recordset.MoveNext
Loop
Dim myval As Long
Dim mustr As String
myval = MsgBox("是否保存该excel表?", vbYesNo, "提示窗口")
If myval = vbYes Then
mystr = InputBox("请输入文件名称", "输入窗口")
If Len(mystr) = 0 Then
MsgBox "系统不允许文件名称为空!", , "提示窗口"
Exit Sub
End If
On Error GoTo errsave
newsheet.SaveAs App.Path & "\excel文件\" & mystr & ".xls"
MsgBox "excel文件保存成功,位置:" & App.Path & "\excel文件\" & mystr & ".xls", , "提示窗口"
newxls.Quit
errsave:
Exit Sub
MsgBox Err.Description, , "提示窗口"
End If
End If
End Sub
传递过去没有显示,报存成功和路径的对话框。但是我打开别的EXCEL表格时能看到这个数据表一闪就没了,关闭这个EXCEL表格时还提示是否保存含有数据的这个表。能帮我调试一下不!谢谢