一个导出EXce的问题?

Question

     vb导出为excel时如何使单元格根据内容大小自动调整大小!~谢谢！

Answer 1

Columns("E:E").EntireColumn.AutoFit '让E列根据内容大小自动调整大小

Answer 2

 2楼能否详细点
我是用flexGrid 直接保存到Excel中的
 Dim ExcelFileName As String
    On Error GoTo ErrMsg
    ExcelFileName = ""
    If VsfVeh.Rows = 1 Then
        MsgBox "   当前表格内没有记录。", vbOKOnly + vbExclamation, "提示"
        Exit Sub
    End If
    DialogSave.DialogTitle = "保存到..."
    DialogSave.InitDir = App.Path
    DialogSave.DefaultExt = "xls|*.xls"
    DialogSave.Filter = "Microsoft Excel 文件(*.xls)|*.xls|所有文件(All.*)|*.*"
    DialogSave.ShowSave
    ExcelFileName = DialogSave.filename
    If ExcelFileName <> "" Then
        If Dir(ExcelFileName) <> "" Then
            If MsgBox("    当前路径下存在同名文件，是否覆盖该文件？", vbYesNo + vbInformation, "操作提示") = vbYes Then
                Me.MousePointer = vbArrowHourglass
                VsfVeh.SaveGrid ExcelFileName, flexFileCustomText, True
                Me.MousePointer = vbDefault
            End If
        Else
            Me.MousePointer = vbArrowHourglass
            VsfVeh.SaveGrid ExcelFileName, flexFileCustomText, True
            Me.MousePointer = vbDefault
        End If
        MsgBox "  当前表格数据成功生成Excle文件!", vbOKOnly + vbInformation, "提示"
    End If
    Exit Sub

Answer 3

将ListView导出成Excel的例子
[code]
'将ListView数据送 Excel 函数
Public Function FillDataArrayListView(asArray(), oLV As ComctlLib.ListView, Optional WithHeader As Boolean = True) As Long
    If Not CheckExcel Then
        MsgBox "无法创建Excel工作表，您可能没有安装或者Excel运行不正常！", vbOKOnly + vbExclamation
        Exit Function
    End If
    Dim nRow As Integer
    Dim nCol As Integer
On Error GoTo FillError
    ReDim asArray(100000, oLV.ColumnHeaders.Count)
    nRow = 0
    
    If WithHeader Then          '如果导出表头
        For nCol = 0 To oLV.ColumnHeaders.Count - 1
            asArray(nRow, nCol) = oLV.ColumnHeaders(nCol + 1).Text
        Next nCol
        nRow = 1
    End If
    
    Dim i As Long
    For i = 1 To oLV.ListItems.Count
        asArray(nRow, 0) = oLV.ListItems(i).Text
        For nCol = 1 To oLV.ColumnHeaders.Count - 1
            asArray(nRow, nCol) = oLV.ListItems(i).SubItems(nCol)
        Next nCol
        nRow = nRow + 1
    Next i
    nRow = nRow + 1
    FillDataArrayListView = nRow
    Exit Function
FillError:
     MsgBox Error$
     Exit Function
     Resume
End Function'将ListView数据导出到Excel表中
Public Sub ExportListView(ByRef oLV As ComctlLib.ListView, ByVal ExportFile As String, Optional ByVal WithHeader As Boolean = True)
    If Not CheckExcel Then
        MsgBox "无法创建Excel工作表，您可能没有安装或者Excel运行不正常！", vbOKOnly + vbExclamation
        Exit Sub
    End If
    Dim strSource, strDestination As String
    Dim asTempArray()
    Dim iNumRows As Long
    Dim objExcel As Object
    Dim objRange As Object
    Dim iStartRow As Long
On Error GoTo ExcelError
    Set objExcel = CreateObject("Excel.Application")
    Call CopyFile(App.Path & "\Excel\empty.xls", ExportFile, True)
    objExcel.WorkBooks.Open ExportFile
    iNumRows = FillDataArrayListView(asTempArray, oLV, WithHeader)         '调填充数组函数
    iStartRow = 1
    Set objRange = objExcel.Range(objExcel.Cells(iStartRow, 1), objExcel.Cells(iNumRows, oLV.ColumnHeaders.Count))
    objRange.Value = asTempArray                                            '填数据
    
    If WithHeader Then          '如果导出表头
        objRange.AutoFormat
    End If
    objExcel.Visible = True                                                         '显示Excel
    objExcel.DisplayAlerts = False                                                '提示保存Excel
    objExcel.Save
    
    Set objExcel = Nothing
    Set objRange = Nothing
    Exit Sub
ExcelError:
    If Err.Number = 1004 Then
        Set objExcel = Nothing
        Exit Sub
    Else
       Resume Next
    End If
End Sub
[/code]