全部

在线等待！怎么把msflexgrid的数据导出到Excel啊？

song0320 2003-06-10 07:21:32

在线等待！怎么把msflexgrid的数据导出到Excel啊？请各位帮个忙！！

...全文

44 点赞收藏 10

写回复

10 条回复

切换为时间正序

当前发帖距今超过3年，不再开放新的回复

发表回复

lihonggen0 2003-06-12

你看看这两篇文章，提速的

http://www.csdn.net/develop/author/netauthor/lihonggen0/

SQL SERVER 与ACCESS、EXCEL的数据转换
Visual Basic 导出到 Excel 提速之法

回复赞

song0320 2003-06-12

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("excel.application")''
''可是我在这句时出现错误说变量使用了一个vb不支持的自动化类型

Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)

For I = 1 To MSHFlexGrid1.Rows
For J = 1 To MSHFlexGrid1.Cols
xlSheet.Cells(I, J) = MSHFlexGrid1.TextMatrix(I, J)
Next J
Next I

xlApp.Visible = True

回复赞

matboy 2003-06-11

tollers(哥呼拉) 很好，我用过，速度很快， lihonggen0(李洪根,用.NET，标准答案来了)的方法速度就不行了，我最初用的就是这个方法，数据大的话等死人。gpo2002(永吹不休) 的方法也是可行的，速度也不慢

回复赞

song0320 2003-06-11

谢谢

回复赞

lihonggen0 2003-06-11

Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet

Set xlApp = CreateObject("excel.application")
Set xlBook = xlApp.Workbooks.Add
Set xlSheet = xlBook.Sheets(1)

For I = 1 To MSHFlexGrid1.Rows
For J = 1 To MSHFlexGrid1.Cols
xlSheet.Cells(I, J) = MSHFlexGrid1.TextMatrix(I, J)
Next J
Next I

xlApp.Visible = True

回复赞

lihonggen0 2003-06-11

http://www.csdn.net/develop/read_article.asp?id=14952

回复赞

zjkisoft 2003-06-11

回复赞

tollers 2003-06-11

'将数据导入到excel worksheet中，先将数据保存在数组中，然后一次性导入worksheet，速度提高无数倍（没算过 :）
'If the function run successfully then return true else return false
'Parameter:
'StartingCell: The position of the Starting cell
'WriteHeader:if true, write the field name, else do not write it

Private Function CopyRecords(RST As ADODB.Recordset, WS As Worksheet, _
StartingCell As ExlCell, WriteHeader As Boolean) As Boolean

Dim SomeArray() As Variant
Dim Row As Long
Dim Col As Long
Dim Fd As ADODB.Field
Dim Recs As Long 'Recordcount
Dim iBeginRow As Integer 'In SomeArray,the begin row of the real data,not header
Dim Counter As Integer, i As Integer

On Error GoTo Err_CopyRecords

'check if recordset is opened
If RST.State <> adStateOpen Then GoTo Err_CopyRecords
' check if recordset is not empty
If RST.EOF And RST.BOF Then GoTo Err_CopyRecords
RST.MoveLast
ReDim SomeArray(0 To RST.RecordCount + 1, 0 To RST.Fields.Count)

iBeginRow = 0

If WriteHeader = True Then
' copy column headers to array
Col = 0
For Each Fd In RST.Fields
SomeArray(0, Col) = Fd.Name
Col = Col + 1
Next
iBeginRow = 1
End If

' copy recordset to SomeArray
RST.MoveFirst
Recs = RST.RecordCount
Counter = 0
For Row = iBeginRow To Recs - 1 + iBeginRow
Counter = Counter + 1
If Counter <= Recs Then i = (Counter / Recs) * 100

For Col = 0 To RST.Fields.Count - 1
SomeArray(Row, Col) = RST.Fields(Col).Value
If IsNull(SomeArray(Row, Col)) Then _
SomeArray(Row, Col) = ""
Next
RST.MoveNext
Next
' The range should have the same number of
' rows and cols as in the recordset
WS.Range(WS.Cells(StartingCell.Row, StartingCell.Col), _
WS.Cells(StartingCell.Row + RST.RecordCount + 1, _
StartingCell.Col + RST.Fields.Count)).Value = SomeArray

Exit_CopyRecords:

On Error GoTo 0
CopyRecords = True
Exit Function

Err_CopyRecords:

CopyRecords = False

End Function

回复赞