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 方法详细用法请看
版权声明:本文内容由互联网用户自发贡献,该文观点与技术仅代表作者本人。本站仅提供信息存储空间服务,不拥有所有权,不承担相关法律责任。如发现本站有涉嫌侵权/违法违规的内容, 请发送邮件至 dio@foxmail.com 举报,一经查实,本站将立刻删除。