将flexgrid中的内容导出到excel中,如何根据flexgrid表格的列宽设定excel中相应列的列宽呀?[同时贴出我的代码]

hsshtj 2006-06-17 10:00:38

将flexgrid中的内容导出到excel中,如何根据flexgrid表格的列宽设定excel中相应列的列宽呀?
-------------
将flexgrid中的内容导出后,在excel中,各个列的宽度是一样的,导致很多列都是重新调整一下列宽才能打印,我想如何在导出时设置一个excel中的列宽呢?
如何设置呢?
请大家给个思路,谢谢.

我的代码如下:
'-----------------------------------------------
'功能：导出电子表格[将表格msflexgrid中的数据直接导出到电子表格中]
'创建日期：2006/06/17
'更新日期：2006/06/17
'参数：
' grd--传过来的表格名称
' arrayflag()--指定各列是否导出，元素下标对应各列，元素值0表不不导出,1表示导出
'-----------------------------------------------
Public Function flexgridtoexcel(grd As MSFlexGrid, arrayflag() As Integer) As Boolean
On Error GoTo errhandle
Dim ColCount As Integer
Dim i As Integer
Dim k As Integer
Dim rowcount As Integer
Dim xlApp As New Excel.Application
Dim xlBook As Excel.Workbook
Dim xlsheet As Excel.Worksheet
Dim sRange As String
Dim icolpos As Integer '电子表格的当前列

ColCount = grd.Cols '取表格列数
rowcount = grd.Rows '取表格行数
xlApp.Visible = True '显示电子表格程序

Set xlBook = xlApp.Workbooks.Add
'Set xlsheet = xlBook.Worksheets(3)
'xlsheet.Visible = xlSheetHidden
'Set xlsheet = xlBook.Worksheets(2)
'xlsheet.Visible = xlSheetHidden '//隐藏sheet2
Set xlsheet = xlBook.Worksheets(1)
xlsheet.Name = "导出数据"

VB.Screen.MousePointer = vbHourglass

'下面合并单元格
' xlsheet.Cells(1, 1) = strtitle
' xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, ColCount)).Merge
'xlsheet.Range(xlsheet.Cells(1, 1), xlsheet.Cells(1, ColCount)).Font.Size = 18

'设置标题[注意：电子表格的行和列都是从1开始的,而flexgrid的行和列都是从0开始的]
icolpos = 0
For i = 0 To ColCount - 1
If arrayflag(i) = 1 Then
icolpos = icolpos + 1
xlsheet.Cells(1, icolpos) = grd.TextMatrix(0, i)
End If
Next

'填入单元格
For i = 1 To rowcount - 1
icolpos = 0
For k = 0 To ColCount - 1
If arrayflag(k) = 1 Then
icolpos = icolpos + 1
xlsheet.Cells(i + 1, icolpos) = CStr(grd.TextMatrix(i, k))
End If
Next
Next

'增加表格线
With xlsheet
.Range(.Cells(1, 1), .Cells(rowcount, icolpos)).Borders.LineStyle = xlContinuous
End With

'xlBook.Close False '不提示保存就关闭
Set xlsheet = Nothing
Set xlBook = Nothing
Set xlApp = Nothing
VB.Screen.MousePointer = vbDefault
flexgridtoexcel = True
Exit Function
errhandle:
VB.Screen.MousePointer = vbHourglass
flexgridtoexcel = False
MsgBox Err.Description
End Function

...全文