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

warnerchen 2003-12-17 10:43:20
如何将MSHFlegGrid中的数据导出Excel啊? 急 ,在线等待啊
...全文
8 点赞 收藏 3
写回复
3 条回复
切换为时间正序
当前发帖距今超过3年,不再开放新的回复
发表回复
lihonggen0 2003-12-17
'*********************************************************

'* 名称: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

回复
lang11zi 2003-12-17
一起等
回复
planetike 2003-12-17
'-------------------------------------------------------------
'作用:将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
回复
发动态
发帖子
VB基础类
创建于2007-09-28

7453

社区成员

VB 基础类
申请成为版主
社区公告
暂无公告