求助：VB导出至Excel问题

Question

没有安装Office软件，怎样从VB中导出数据为Excel格式?
(Excel格式可以用WPS打开)

Answer 1

'调用格式 ExportExcel1 mshflexgrid1  '导出记录到电子表格Public Sub ExportExcel1(ByVal MyObject As Object)    On Error Resume Next    Dim i As Integer, j As Integer, Rows As Integer, Cols As Integer
    Dim Firsti As Integer
    Dim NashXl As Object, tmpChr As String
    Dim excel_app As Object, excel_sheet As Object    Dim xlNone As Integer, xlEdgeLeft As Integer, xlContinuous As Integer, xlThin As Integer
    Dim xlAutomatic As Integer, xlEdgeTop As Integer, xlEdgeBottom As Integer
    Dim xlEdgeRight As Integer, xlInsideVertical As Integer, xlInsideHorizontal As Integer
    Dim xlDiagonalDown As Integer, xlDiagonalUp As Integer, xlCenter As Integer, xlMedium As Integer
    Dim xlNormal As Integer    'Dim fso As New FileSystemObject    Screen.MousePointer = 11
    '定义Excel中关于边框和文字位置的常量
    xlContinuous = 1
    xlThin = 2
    xlDiagonalDown = 5
    xlDiagonalUp = 6
    xlEdgeLeft = 7
    xlEdgeTop = 8
    xlEdgeBottom = 9
    xlEdgeRight = 10
    xlInsideVertical = 11
    xlInsideHorizontal = 12
    xlNone = -4142
    xlAutomatic = -4105
    xlCenter = -4108
    xlMedium = -4138
    xlNormal = -4143    '打开Excel
    Rows = MyObject.Rows
    Cols = MyObject.Cols
          
    'Set excel_app = CreateObject("excel.application")  '调用Office Excel的表格程序*****
    
     Set excel_app = CreateObject("et.application")   '调用WPS的表格程序************
    '新增一个空的Excel的Sheet页
    excel_app.Workbooks.Add    If Val(excel_app.Application.Version) >= 8 Then
        Set excel_sheet = excel_app.ActiveSheet
    Else
        Set excel_sheet = excel_app
    End If    Set NashXl = excel_sheet.Application    excel_sheet.Name = "导出记录"
    
    For i = 0 To Rows - 1
        For j = 1 To Cols
            excel_sheet.Cells(i + 1, j).Value = MyObject.TextMatrix(i, j)
        Next j
    Next i    'tmpChr = IntToChr( iRow1 As Integer, iCol1 As Integer, iRow2 As Integer, iCol2 As Integer ),
    '参数iRow1 , iCol1表示线框在Excel中的起始处的单元格    tmpChr = IntToChr(1, 1, Rows, Cols - 1)
    NashXl.Range(tmpChr).Select
    NashXl.Selection.Columns.AutoFit  '自动调整列宽
    NashXl.Selection.Font.Size = 10  '字体大小
    NashXl.Selection.Name = "test"    NashXl.Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    NashXl.Selection.Borders(xlDiagonalUp).LineStyle = xlNone    With NashXl.Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic    End With
    With NashXl.Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic
    End With
    With NashXl.Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic
    End With
    With NashXl.Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic
    End With
    With NashXl.Selection.Borders(xlInsideVertical)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic
    End With
    With NashXl.Selection.Borders(xlInsideHorizontal)
        .LineStyle = xlContinuous
        .Weight = xlThin
        '        .ColorIndex = xlAutomatic
    End With    '''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''    excel_app.ActiveWorkbook.SaveAs "C:\导出数据.xls"      '另存为    excel_app.Visible = True
    Set NashXl = Nothing
    Set excel_sheet = Nothing
    Set excel_app = Nothing
    Screen.MousePointer = 0End SubPublic Function IntToChr(iRow1 As Integer, iCol1 As Integer, iRow2 As Integer, iCol2 As Integer) As String
    Dim i As Integer, j As Integer, tmpi As Integer
    Dim Tmpstr(1 To 2) As String
    If iCol1 < 1 Or iCol1 > 256 Or iCol2 < 1 Or iCol2 > 256 Then
        IntToChr = ""
        Exit Function
    End If    j = iCol1 Mod 26
    If j = 0 Then
        i = (iCol1 \ 26) - 1
        j = 26
    Else
        i = (iCol1 \ 26)
    End If    If i > 0 Then
        Tmpstr(1) = Chr(64 + i) & Chr(64 + j)
    Else
        Tmpstr(1) = Chr(64 + j)
    End If    j = iCol2 Mod 26
    If j = 0 Then
        i = (iCol2 \ 26) - 1
        j = 26
    Else
        i = (iCol2 \ 26)
    End If    If i > 0 Then
        Tmpstr(2) = Chr(64 + i) & Chr(64 + j)
    Else
        Tmpstr(2) = Chr(64 + j)
    End If    IntToChr = Tmpstr(1) & iRow1 & ":" & Tmpstr(2) & iRow2
End Function

Answer 2

1楼没看清楚楼主的意思,他是问没装OFFICE怎么导出
-------------------------------------------
LZ换个思路吧;你先把要导出的内容写入文本文件t.txt,列值之间用TAB做分割,行间用VBNEWLINE;
然后  name t.txt x.xls  就可以了

Answer 3

1楼给辛苦费
2楼给思路费剩下60分征集另一种思路:COM.Excel.dll

Answer 4

直接导出到 WPS就行了,还用转格式干嘛,不懂?

Answer 5

WPS就支持直接导出的!和Office的Excel一样

Answer 6

用vsflexgrid 显示数据就可以直接导成Excel文件而不用安装OFFICE了