老问题，但解决不了，关于msflexgrid导出EXCEL并打印的问题
用一般的办法是实现了导了EXCEL并可以打印，但是速度太慢，后来把msflexgrid的数据存到一个数组里，
但在如何选定EXCEL表一个范围，然后再把数组赋值给这一范围的时候就搞不定了……
请大家帮帮，最好详细些， 谢谢，
[解决办法]
Set VBExcel = CreateObject( "Excel.Application ")
With VBExcel
.Workbooks.Open App.Path + "\ " + "导出.xls " 'app.path是程序的相对路径
.Visible = True
For i = 0 To Xhnum - 1
For j = 0 To Xlnum - 1
.cells(i + 2, j + 1).Value = Xssz(j, i)
Next
Next
End With
其实就是一个一个的格子写。有多大的二维数组，就写成多少范围。最左上角的那个格子确定了整个范围的位置，.cells(i + 2, j + 1)中，调整参数2或1.就调整了位置.
[解决办法]
这个非常好用：
Public Sub ExportDataTo(ByVal MSFG As MSFlexGrid)
Dim x As Excel.Application
Dim I As Long
Dim j As Long
Dim nCols As Long
Dim nRows As Long
Set x = CreateObject( "excel.application ")
x.Visible = False
nCols = MSFG.Cols
nRows = MSFG.Rows
I = 1
j = 1
Dim Book As Excel.Workbook
Set Book = x.Workbooks.Add(xlWorksheet)
With x.ActiveSheet
While I <= nRows
j = 1
While j < nCols
.Cells(I, j) = " ' " + MSFG.TextMatrix(I - 1, j)
j = j + 1
Wend
I = I + 1
Wend
For j = 1 To nCols - 1
.Columns(j).AutoFit
Next
End With
x.Visible = True
End Sub
===============================
在导出时调用，写以下代码即可：
Screen.MousePointer = vbHourglass
ExportDataTo MSFGQueryPay
Screen.MousePointer = vbDefault
[解决办法]
用excel就是快不了，你说的方案，好像是没有
[解决办法]
ActiveSheet.Range( "a3 ").value = a(b, d)这个方法要比循环中第次都去访问一下cells效率高出许多，这个在MSDN上就有示例
[解决办法]
我在asp.net中一直是这样使用的，刚才修改了一下代码，这个在VB6下通过：
Dim DataArray() As String
Dim r As Integer, c As Integer
ReDim DataArray(fg.Rows - 1, fg.Cols - 1)
For r = 1 To fg.Rows - 1
For c = 1 To fg.Cols - 1
DataArray(r - 1, c - 1) = fg.TextMatrix(r, c)
Next c
Next r
Dim oExcel As Object
Dim oBook As Object
Dim oSheet As Object
Set oExcel = CreateObject( "Excel.Application ")
Set oBook = oExcel.Workbooks.Add
Set oSheet = oBook.Worksheets(1)
oSheet.Range( "A1 ").Value = "列1 "
oSheet.Range( "B1 ").Value = "列2 "
oSheet.Range( "C1 ").Value = "列3 "
oSheet.Range( "D1 ").Value = "列4 "
oSheet.Range( "A2 ").Resize(fg.Rows - 1, fg.Cols - 1).Value = DataArray
oExcel.Visible = True
Set oSheet = Nothing
Set oBook = Nothing
oExcel.Quit
Set oExcel = Nothing
msdn上的相关内容我试试找一下，都是以前看的了
[解决办法]
’通用类
’MSFlexGrid Export to MSExcel
Public Function FlexGrd_SaveToExcel(FG As MSFlexGrid, Optional sHeader As String = " ", Optional sFooter As String = " ", Optional ColumnHeaderFontColorIndex As Long, Optional ColumnHeaderBackColorIndex As Long, Optional CoLogoPicLocation As String, Optional WorkBkBackColorIndex As Long, Optional WorkBkGridColorIndex As Long, Optional AlternateRowColorIndex1 As Long, Optional AlternateRowColorIndex2 As Long, Optional AutoColumnFitter As Boolean)
' Autofit columns
' Alternating row colors in excel
Static objExcelDel As Object
Static objWorkbookDel As Excel.Workbook
Static objWorksheetDel As Excel.Worksheet
Static HeadRange As Excel.Range
Static NewRange As Excel.Range
Static GridRange As Range
Static PicObject As Excel.ShapeRange
Dim lRow As Integer, lCol As Integer
Dim i As Integer, J As Integer
Dim C As Integer
Dim rowOffset As Long
Dim TempStr() As String
Set objExcelDel = CreateObject( "Excel.application ")
If Err.Number <> 0 Then
Set objExcelDel = New Excel.Application
Err.Clear
End If
On Error Resume Next
objExcelDel.Visible = False
If Len(sHeader) > 0 Then
TempStr = Split(sHeader, vbTab)
rowOffset = UBound(TempStr) + 1
End If
Set objWorkbookDel = objExcelDel.Workbooks.Add
'Turn off the alerts
objExcelDel.DisplayAlerts = False
'Set objWorksheet to the remaining worksheet.
Set objWorksheetDel = objExcelDel.ActiveSheet
With objWorksheetDel
' Sheet Header
For lRow = 1 To rowOffset
.PageSetup.CenterHeader = TempStr(lRow - 1)
Next lRow
' Get Column Headers
For lRow = 1 To FG.FixedRows
For lCol = 1 To FG.Cols
.Cells(4, lCol - 1) = FG.TextMatrix(lRow - 1, lCol - 1)
Next lCol
Next lRow
If Val(WorkBkBackColorIndex) > 0 Then
objWorkbookDel.Styles( "Normal ").Interior.ColorIndex = WorkBkBackColorIndex
End If
'Gridlines will not be visible but you can add that to by
If Val(WorkBkGridColorIndex) > 0 Then
With objWorkbookDel.Styles( "Normal ").Borders(xlLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1 ' 1 is black
End With
With objWorkbookDel.Styles( "Normal ").Borders(xlRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With objWorkbookDel.Styles( "Normal ").Borders(xlTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
With objWorkbookDel.Styles( "Normal ").Borders(xlBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1
End With
End If
Set HeadRange = objWorksheetDel.Range(objWorksheetDel.Cells(4, 1), _
objWorksheetDel.Cells(4, lCol - 2))
With HeadRange
'*****Sets Column Header Back Color
If Val(ColumnHeaderBackColorIndex) > 0 Then
.Interior.ColorIndex = ColumnHeaderBackColorIndex
Else
' My Default Background color for Column header index change it to what ever you want
.Interior.ColorIndex = 5
End If
.Interior.Pattern = xlSolid
.Interior.PatternColorIndex = 6
.Interior.Pattern = xlLightHorizontal
.Interior.ColorIndex = 20
.Font.Name = "Rockwell "
.Font.FontStyle = "Bold "
.Font.Shadow = True
'***** Sets Column header Font color*****
If Val(ColumnHeaderFontColorIndex) > 0 Then
.Font.ColorIndex = ColumnHeaderFontColorIndex
Else
' My Default Font color for Column header index change it to what ever you want
.Font.ColorIndex = 2
End If
.Font.Bold = True
'************************************
'Sets border colors of header. You could also add this
'to the function but I thought I was getting carried away
'as it was.
With .Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16 'grey
End With
With .Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With .Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With .Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 16
End With
With .Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = 1 ' Black
End With
End With
HeadRange = Nothing
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
Dim RowCounter As Integer ' used for all alternate row color
RowCounter = 0 ' ditto
' Dim ColCounter As Integer ' used for all alternate row color
' ColCounter = 0
Dim G As Integer ' ditto
Dim Alternate As Boolean 'ditto
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Fill excel sheet with data
' Row data from flexgrid
For i = 1 To FG.Rows
For J = 0 To FG.Cols
objWorksheetDel.Cells(i + 4, J) = FG.TextMatrix(i, J)
objWorksheetDel.Cells(i + 4, J + 1).VerticalAlignment = xlTop
Next J
RowCounter = RowCounter + 1
Next i
RowCounter = RowCounter - 1 ' Getting rid of extra row
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Alternate row colors on Excel spreadsheet
If AlternateRowColorIndex1 <> " " And AlternateRowColorIndex2 <> " " Then
G = 0
Do Until G = RowCounter ' RowCounter is figured when row data is taken
Set NewRange = objWorksheetDel.Range(objWorksheetDel.Cells(G + 5, 1), _
objWorksheetDel.Cells(G + 5, lCol - 2))
With NewRange
If Alternate <> True Then
.Interior.ColorIndex = AlternateRowColorIndex1
.Borders.ColorIndex = 31
'Sets font color either 1 Black or 2 white for row
Select Case AlternateRowColorIndex1
Case 1, 3, 5, 9, 11, 13, 14, 16, 17, 21, 23, 25
.Font.ColorIndex = 2
Case Else
.Font.ColorIndex = 1
End Select
Alternate = True
Else
.Interior.ColorIndex = AlternateRowColorIndex2
.Borders.ColorIndex = 31
'Sets font color either 1 Black or 2 white
Select Case AlternateRowColorIndex2
Case 1, 3, 5, 9, 11, 13, 14, 16, 17, 21, 23, 25
.Font.ColorIndex = 2
Case Else
.Font.ColorIndex = 1
End Select
Alternate = False
End If
End With
NewRange = Nothing
G = G + 1
Loop
End If
' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' ' '
' Autofit columns
If AutoColumnFitter = True Then
.Columns.AutoFit
End If
'******************************************
objWorksheetDel.OLEObjects
' Page Footer
If Len(sFooter) > 0 Then
TempStr = Split(sFooter, vbTab)
For lRow = 0 To UBound(TempStr)
.PageSetup.CenterFooter = TempStr(lRow)
Next lRow
End If
End With
objExcelDel.Visible = True
objExcelDel.DisplayAlerts = True
Set objWorksheetDel = Nothing
Set objWorkbookDel = Nothing
Set objExcelDel = Nothing
End Function
