vb6.0里datagrid里的数据怎么导到excel里?
用vb6.0+access做的数据库程序,如果想把datagrid里的数据打印出来怎么实现?还有就是怎么导出到excel里?搜索了好多资料,想知道具体的解决方案。请指教!...
用vb6.0+access做的数据库程序,如果想把datagrid里的数据打印出来怎么实现?还有就是怎么导出到excel里?
搜索了好多资料,想知道具体的解决方案。请指教!
自动保存EXCEL那项功能不成功。怎么处理? 展开
搜索了好多资料,想知道具体的解决方案。请指教!
自动保存EXCEL那项功能不成功。怎么处理? 展开
1个回答
展开全部
如果想把datagrid里的数据打印出来怎么实现
方法太多了,可以直接打印窗体,可以用水晶报表,可以调用printer,但如果你把它导出到Excel,比上面的方案都好。
导出到EXCEL要用到excel程序提供的Application对像
使用前先在 工程 --引用 里添加Microsoft excel.....的引用。
然后定义 application...
还是给你看一段代码吧。希望对你有帮助
控件 adodc+datagrid+command
Private Sub cmdExport_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") '创建excel应用程序,打开excel2000
Set newbook = newxls.Workbooks.Add '创建工作簿
Set newsheet = 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 mystr 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
补充回答:因为路径不丰在,换一个存在的路径,不行就改成 App.Path & mystr & ".xls" 之类
方法太多了,可以直接打印窗体,可以用水晶报表,可以调用printer,但如果你把它导出到Excel,比上面的方案都好。
导出到EXCEL要用到excel程序提供的Application对像
使用前先在 工程 --引用 里添加Microsoft excel.....的引用。
然后定义 application...
还是给你看一段代码吧。希望对你有帮助
控件 adodc+datagrid+command
Private Sub cmdExport_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") '创建excel应用程序,打开excel2000
Set newbook = newxls.Workbooks.Add '创建工作簿
Set newsheet = 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 mystr 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
补充回答:因为路径不丰在,换一个存在的路径,不行就改成 App.Path & mystr & ".xls" 之类
参考资料: 补充回答:因为路径不丰在,换一个存在的路径,不行就
推荐律师服务:
若未解决您的问题,请您详细描述您的问题,通过百度律临进行免费专业咨询