分享：VB6_0 VB导出excel 方法源代码(转载) 百度空间_应用平台

分享：VB6.0 VB导出excel 方法源代码(转载) 百度空间_应用平台应用注册用户名: 密码:
HOHO照片PK分享投票测试礼物开心部落汽车工厂七彩鱼
更多
网页游戏分享 热门分享最新分享好友的分享我的分享分享有礼啦！iPad大奖周周送！速速关注吧>> 如何分享? 问题反馈
闪电新宇的分享分享
VB6.0 VB导出excel 方法源代码(转载)
方法一：
用Msflexgrid的Textmatrix属性取Msflexgrid中每一个单元格的内容，然后填到Excel表中，或者写成CSV格式

方法二：
直接把查询结果导出成Excel工作表
Public Sub Export(formname As Form, flexgridname As String)
Dim xlApp As Object 'Excel.Application
Dim xlBook As Object 'Excel.Workbook
Dim xlSheet As Object 'Excel.Worksheet
Screen.MousePointer = vbHourglass
On Error GoTo Err_Proc
Set xlApp = CreateObject("Excel.Application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Worksheets(1)
'Begin to fill data to sheet
Dim i As Long
Dim j As Integer
Dim k As Integer
With formname.Controls(flexgridname)
For i = 0 To .rows - 1
k = 0
For j = 0 To .Cols - 1
If .colwidth(j) > 20 Or .colwidth(j)
< 0 Then
k = k + 1
xlSheet.Cells(i + 1, k).Value
= "'" & .TextMatrix(i, j)
End If
Next j
Next i
End With
xlApp.Visible = True
Screen.MousePointer = vbDefault
Exit Sub
Err_Proc:
Screen.MousePointer = vbDefault
MsgBox "请确认您的电脑已安装Excel！", vbExclamation,"提示"

End Sub
===================================
Public Function ExporToExcel(strOpen As String)
'*********************************************************
'* 名称：ExporToExcel
'* 功能：导出数据到EXCEL
'* 用法：ExporToExcel(sql查询字符串)
'*********************************************************
Dim Rs_Data As New ADODB.Recordset
Dim Irowcount As Integer
Dim Icolcount As Integer
Dim cn As New ADODB.Connection
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim xlQuery As Excel.QueryTable
With Rs_Data

If .State = adStateOpen Then
.Close
End If
.ActiveConnection = "provider=msdasql;DRIVER=Microsoft
Visual FoxPro
Driver;UID=;Deleted=yes;Null=no;Collate=Machine;BackgroundFetch=no;Exclusive=No;SourceType=DBF;SourceDB=D:\DBF;"

.CursorLocation = adUseClient
.CursorType = adOpenStatic
.Source = strOpen
.Open
End With
With Rs_Data
If .RecordCount < 1 Then
MsgBox ("没有记录!")
Exit Function
End If
'记录总数
Irowcount = .RecordCount
'字段总数
Icolcount = .Fields.Count
End With

Set xlApp = CreateObject("Excel.Application")
Set xlBook = Nothing
Set xlSheet = Nothing
Set xlBook = xlApp.Workbooks().Add
Set xlSheet = xlBook.Worksheets("sheet1")
xlApp.Visible = True

'添加查询语句，导入EXCEL数据
Set xlQuery = xlSheet.QueryTables.Add(Rs_Data,
xlSheet.Range("a1"))

xlQuery.FieldNames = True '显示字段名
xlQuery.Refresh

xlApp.Application.Visible = True
Set xlApp = Nothing '"交还控制给Excel
Set xlBook = Nothing
Set xlSheet = Nothing

End Function
==============================
'*********************************************************
'* 名称：OutDataToExcel
'* 功能：将MsFlexGrid控件中显示的内容输出到Excel表格中进行打印
'*********************************************************
Public Sub OutDataToExcel(Flex As MSFlexGrid) '导出至Excel
Dim s As String
Dim i As Integer
Dim j As Integer
Dim k As Integer
On Error GoTo Ert
Me.MousePointer = 11
Dim Excelapp As Excel.Application
Set Excelapp = New Excel.Application
On Error Resume Next
DoEvents
Excelapp.SheetsInNewWorkbook = 1
Excelapp.Workbooks.Add
Excelapp.ActiveSheet.Cells(1, 3) = s
Excelapp.Range("C1").Select
Excelapp.Selection.Font.FontStyle = "Bold"
Excelapp.Selection.Font.Size = 16
With Flex
k = .Rows
For i = 0 To k - 1
For j = 0 To .Cols - 1

DoEvents
Excelapp.ActiveSheet.Cells(3 + i, j +
1) = "'" & .TextMatrix(i, j)
Next j
Next i
End With
Me.MousePointer = 0
Excelapp.Visible = True
Excelapp.Sheets.PrintPreview
Ert:
If Not (Excelapp Is Nothing) Then
Excelapp.Quit
End If
End Sub
为了您的安全，请只打开来源可靠的网址
打开网站 取消来自:
/cadel1985/blog/item/4725e0294b504af499250a8f.html
来自:
cadel1985 第一分享:
闪电新宇 时间: 2010-08-21 14:28 评论: 1条 投票: 0次 本贴分享: 2 累计分享: 3 共有0人发表观点
...目前还没有互动观点，输入您的互动观点 闪电新宇的 相关分享:
apache+tomcat配置[转]
音频规范的发展：AC97和HD AUDIO
VB隐藏进程
vb long 溢出 范围评论(1)
帮助中心 | 空间客服 | 投诉中心 | 空间协议 | 联系我们
2006-2011 © Baidu