如何将MSHFlegGrid中的数据导出Excel啊？ 急 ，在线等待啊

[warnerchen]

如何将MSHFlegGrid中的数据导出Excel啊？ 急 ，在线等待啊

[planetike]

'-------------------------------------------------------------
'作用：将Vsflexgrid中的数据导出到excel中
'参数：Vsflexgrid表格
'程序出口：
'日期：2003-11-11
'修改备注：
'-------------------------------------------------------------
Public Sub FlextoExcel(ByVal grid As vsFlexArray)
On Error Resume Next
Dim myExcel As excel.Application
If err.Number <> 0 Then
err.Clear '清除错误，系统不捕获错误，从而系统在运行时不报错
End If
'打开Execl应用程序
Set myExcel = CreateObject("Excel.application")
' myExcel.AutoCorrect.Application.WindowState = 2
myExcel.Application.Workbooks.Add (True)
myExcel.AutoCorrect.Application.Visible = True
'设置表头
Dim i As Integer
'从第一列开始
myExcel.Worksheets("Sheet1").Activate

For i = 1 To grid.Cols - 1
myExcel.Columns(i).ColumnWidth = grid.ColWidth(i) / 100
myExcel.Range(Cells(1, i), Cells(1, i)).Borders.LineStyle = xlDouble
myExcel.Range(Cells(1, i), Cells(1, i)).Select
myExcel.Cells(1, i) = "'" & grid.TextMatrix(0, i)
myExcel.Selection.Font.FontStyle = "Bold"
myExcel.Selection.Font.Size = 16
myExcel.Selection.Font.Color = vbBlue
myExcel.Selection.HorizontalAlignment = xlCenter
myExcel.Selection.VerticalAlignment = xlCenter
myExcel.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
myExcel.Selection.Borders(xlDiagonalUp).LineStyle = xlNone
myExcel.Selection.Border(xlEdgeLeft).LineStyle = xlContinuous
myExcel.Selection.Border(xlEdgeLeft).Weight = xlThin
myExcel.Selection.Border(xlEdgeLeft).ColorIndex = xlAutomatic
myExcel.Selection.Border(xlEdgeRight).LineStyle = xlContinuous
myExcel.Selection.Border(xlEdgeRight).Weight = xlThin
myExcel.Selection.Border(xlEdgeRight).ColorIndex = xlAutomatic
myExcel.Selection.Border(xlEdgeTop).LineStyle = xlContinuous
myExcel.Selection.Border(xlEdgeTop).Weight = xlThin
myExcel.Selection.Border(xlEdgeTop).ColorIndex = xlAutomatic
myExcel.Selection.Border(xlEdgeBottom).LineStyle = xlContinuous
myExcel.Selection.Border(xlEdgeBottom).Weight = xlThin
myExcel.Selection.Border(xlEdgeBottom).ColorIndex = xlAutomatic
Next
Dim m As Integer '行
Dim N As Integer '列
For m = 1 To grid.Rows - 1
For N = 1 To grid.Cols - 1
myExcel.Range(Cells(m + 1, N), Cells(m + 1, N)).Select
myExcel.Cells(m + 1, N) = "'" & grid.TextMatrix(m, N)
Next
Next
' myExcel.AutoCorrect.Application.WindowState = 0
'myExcel.Sheets.PrintPreview

End Sub

[lang11zi]

一起等

[lihonggen0]

'*********************************************************

'* 名称：OutDataToExcel

'* 功能：将MshFlexGrid控件中显示的内容输出到Excel表格中进行打印

'*********************************************************

Public Sub OutDataToExcel(Flex As MSHFlexGrid) '导出至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