vb6.0 office excel 和wps共存，创建正确的excel对象以便操作excel表格

vb.net版请看vb.net分类下另外一篇文章

文中代码在以下环境测试通过

1.win7 64位+vb6.0企业版+office 2010 32位

2.XP+vb6.0企业版+wps 2016 尝鲜版

3.win10+wps 2016 尝鲜版+office 2003

需要函数

''' <summary>
'''office97              8.0
'''office2000             9.0
'''officeXP (2002)        10.0
'''office2003             11.0
'''office2007             12.0
'''office2010             14.0
'''根据系统安装的Excel（Excel或者wps）创建Excel对象
''' 一定要先et 然后在ket 最后才是excel
''' 在系统中，office excel 比wps 表格具有优先级或者是注册表里面某项决定的
''' </summary>
''' <param name="xlApp"></param>
''' <param name="ISAM">索引顺序访问方法</param>
''' <param name="filter">文件后缀</param>
''' <returns></returns>
Public Function CreateExcelObject(ByRef xlApp As Object,ByRef ISAM As String,ByRef filter As String) As Boolean
    On Error GoTo ErrHandle
    Dim funcResult As Boolean
    
    '尝试创建wps对象（et 或者ket）
    If GetWPS_V8VerFromActiveX(xlApp,ISAM,filter) = True Then
        CreateExcelObject = True
        Exit Function
    End If
    If GetWPS_V9VerAboveFromActiveX(xlApp,filter) = True Then
        CreateExcelObject = True
        Exit Function
    End If
    
    '创建wps对象失败说明没有安装wps,此时尝试创建excel对象
    '如果创建excel对象失败，说明本地也没有安装excel
    If GetExcelFromActiveX(xlApp,filter) = True Then
        CreateExcelObject = True
        Exit Function
    End If
    
    CreateExcelObject = funcResult
ErrHandle:
    Select Case Err.Number
        Case 0
            'DoNothing
        Case 429
            If xlApp Is Nothing Then
                CreateExcelObject = funcResult
            End If
            Debug.Print ("获取Excel或者WPS对象失败")
        Case Else
            MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description,vbCritical,"错误"
    End Select
End Function

'==========================================================
'| 模 块 名 | GetWPS_V8VerFromActiveX
'| 说  明   | ET.Application对象直接获取当前WPS版本
'       版本            开发版本号
Private Function GetWPS_V8VerFromActiveX(ByRef xlApp As Object,ByRef filter As String) As Boolean
    On Error GoTo ErrHandle
    Dim xlappVersion As Double
    
    Set xlApp = CreateObject("ET.Application")
    xlApp.Visible = False
    xlappVersion = CDbl(xlApp.Version)
    Select Case xlappVersion
        Case Is <= 11#
            filter = ".xls"
            ISAM = "Excel 8.0"
            GetWPS_V8VerFromActiveX = True
        Case Else
            filter = ".xlsx"
            ISAM = "Excel 12.0 Xml"
            GetWPS_V8VerFromActiveX = True
    End Select
    Debug.Print "获取WPSV8及以下版本成功"
ErrHandle:
    Select Case Err.Number
        Case 0
            'DoNothing
        Case 429    'ActiveX 部件不能创建对象(电脑没有安装此对象)
            filter = ""
            ISAM = ""
            Debug.Print "获取WPSV8及以下版本失败"
        Case Else
            MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description,"错误"
            Debug.Print "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    End Select
End Function

'==========================================================
'| 模 块 名 | GetWPS_V9VerAboveFromActiveX
'| 说  明   | KET.Application对象直接获取当前WPS版本(版本号为9以上的)
'       版本            开发版本号
Private Function GetWPS_V9VerAboveFromActiveX(ByRef xlApp As Object,ByRef filter As String) As Boolean
    On Error GoTo ErrHandle
    Dim xlappVersion As Double
    
    Set xlApp = CreateObject("KET.Application")
    xlApp.Visible = False
    xlappVersion = CDbl(xlApp.Version)
    Select Case xlappVersion
        Case Is <= 11#
            filter = ".xls"
            ISAM = "Excel 8.0"
            GetWPS_V9VerAboveFromActiveX = True
        Case Else
            filter = ".xlsx"
            ISAM = "Excel 12.0 Xml"
            GetWPS_V9VerAboveFromActiveX = True
    End Select
    Debug.Print "获取WPSV9及以上版本成功"
ErrHandle:
    Select Case Err.Number
        Case 0
            'DoNothing
        Case 429    'ActiveX 部件不能创建对象(电脑没有安装此对象)
            filter = ""
            ISAM = ""
            Debug.Print "获取WPSV9及以上版本失败"
        Case Else
            MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description,"错误"
            Debug.Print "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    End Select
End Function

'==========================================================
'| 模 块 名 | GetExcelFromActiveX
'| 说  明   | 获取所有excel版本对象 如果有
'       版本            开发版本号
Private Function GetExcelFromActiveX(ByRef xlApp As Object,ByRef filter As String) As Boolean
    On Error GoTo ErrHandle
    Dim xlappVersion As Double
    
    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False
    xlappVersion = CDbl(xlApp.Version)
    Select Case xlappVersion
        Case Is <= 11#
            filter = ".xls"
            ISAM = "Excel 8.0"
            GetExcelFromActiveX = True
        Case Else
            filter = ".xlsx"
            ISAM = "Excel 12.0 Xml"
            GetExcelFromActiveX = True
    End Select
    Debug.Print "获取Excel版本成功"
ErrHandle:
    Select Case Err.Number
        Case 0
            'DoNothing
        Case 429    'ActiveX 部件不能创建对象(电脑没有安装此对象)
            filter = ""
            ISAM = ""
            Debug.Print "获取Excel版本失败"
        Case Else
            MsgBox "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description,"错误"
            Debug.Print "错误代码：" & Err.Number & vbCrLf & "错误描述：" & Err.Description
    End Select
End Function

调用

    Dim xlApp As Object
    Dim excelFilter As String
    Dim excelISAM As String

    '后期绑定Excel对象 不需要知道系统安装的是哪个版本的Excel
    '不需要引用Excel
    If CreateExcelObject(xlApp,excelISAM,excelFilter) = False Then
    	MsgBox "本机未安装Excel或者WPS，导出失败！",vbInformation,"温馨提示"
    End If

另外，有时候操作excel会提示 “类 Workbook 的 SaveAs 方法无效”错误。

这个错误通常是电脑同时安装了低版本office excel（如2003）和高版本wps（如最新版2016）导致的。

如果你用保存的代码是

        If xlApp.Version > 11# Then
            xlBook.SaveAs xlsFileName,51
        ElseIf xlApp.Version <= 11# Then
            xlBook.SaveAs xlsFileName,56
        End If

请改成，系统会自动帮你保存文件为当前所用 Excel 版本的格式

        If xlApp.Version > 11# Then
            xlsFileName = xlsFileName & ".xlsx"
        ElseIf xlApp.Version <= 11# Then
            xlsFileName = xlsFileName & ".xls"
        End If

        Call xlBook.SaveAs(xlsFileName)

Worksheet.SaveAs 方法详细用法请看

https://msdn.microsoft.com/zh-cn/library/ff195820(v=office.15).aspx

原文链接：https://www.f2er.com/vb/256902.html

vb6.0 office excel 和wps共存，创建正确的excel对象以便操作excel表格

猜你在找的VB相关文章