cad vba 打开excel并弹窗打开指定文件

 CAD vba 代码实现打开excel,并通过对话框选择xls文件，并打开此文件进行下一步操作。代码如下:

excel.activeworkbook.sheets(1) ''

excel对象下activeworkbook,再往下是sheets对象，(1)为第一个表，

thisworkbook是vba代码所在的工作簿。


Option Explicit
#If VBA7 Then
Private Declare PtrSafe Function ts_apiGetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function ts_apiGetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (tsFN As tsFileName) As Boolean
Private Declare PtrSafe Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
Private Declare PtrSafe Function SHGetPathFromIDList Lib "shell32.dll" Alias _
"SHGetPathFromIDListA" (ByVal pidl As LongPtr, ByVal pszPath As String) As LongPtr
Private Declare PtrSafe Function SHBrowseForFolder Lib "shell32.dll" Alias _
"SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As LongPtr
Private Const BIF_RETURNONLYFSDIRS = &H1
Private Type BROWSEINFOhOwner As LongPtrpidlRoot As LongPtrpszDisplayName As StringlpszTitle As StringulFlags As LongPtrlpfn As LongPtrlParam As LongPtriImage As LongPtr
End Type
Private Type tsFileNamelStructSize As LonghwndOwner As LongPtrhInstance As LongPtrstrFilter As StringstrCustomFilter As StringnMaxCustFilter As LongnFilterIndex As LongstrFile As StringnMaxFile As LongstrFileTitle As StringnMaxFileTitle As LongstrInitialDir As StringstrTitle As Stringflags As LongnFileOffset As IntegernFileExtension As IntegerstrDefExt As StringlCustData As LonglpfnHook As LongPtrlpTemplateName As String
End Type' Flag Constants
Private Const tscFNAllowMultiSelect = &H200
Private Const tscFNCreatePrompt = &H2000
Private Const tscFNExplorer = &H80000
Private Const tscFNExtensionDifferent = &H400
Private Const tscFNFileMustExist = &H1000
Private Const tscFNPathMustExist = &H800
Private Const tscFNNoValidate = &H100
Private Const tscFNHelpButton = &H10
Private Const tscFNHideReadOnly = &H4
Private Const tscFNLongNames = &H200000
Private Const tscFNNoLongNames = &H40000
Private Const tscFNNoChangeDir = &H8
Private Const tscFNReadOnly = &H1
Private Const tscFNOverwritePrompt = &H2
Private Const tscFNShareAware = &H4000
Private Const tscFNNoReadOnlyReturn = &H8000
Private Const tscFNNoDereferenceLinks = &H100000Public Function GOFN( _Optional ByRef rlngflags As Long = 0&, _Optional ByVal strInitialDir As String = "", _Optional ByVal strFilter As String = "dwg文件 (*.dwg)" & vbNullChar & "*.dwg" _& vbNullChar & "All Files (*.*)" & vbNullChar & "*.*", _Optional ByVal lngFilterIndex As Long = 1, _Optional ByVal strDefaultExt As String = "", _Optional ByVal strFileName As String = "", _Optional ByVal strDialogTitle As String = "", _Optional ByVal fOpenFile As Boolean = True) As Variant
'On Error GoTo GOFN_ErrDim tsFN As tsFileNameDim strFileTitle As StringDim fResult As Boolean' Allocate string space for the returned strings.strFileName = Left(strFileName & String(256, 0), 256)strFileTitle = String(256, 0)' Set up the data structure before you call the functionWith tsFN.lStructSize = LenB(tsFN)'.hwndOwner = Application.hWndAccessApp.strFilter = strFilter.nFilterIndex = lngFilterIndex.strFile = strFileName.nMaxFile = Len(strFileName).strFileTitle = strFileTitle.nMaxFileTitle = Len(strFileTitle).strTitle = strDialogTitle.flags = rlngflags.strDefExt = strDefaultExt.strInitialDir = strInitialDir.hInstance = 0.strCustomFilter = String(255, 0).nMaxCustFilter = 255.lpfnHook = 0End With' Call the function in the windows APIfResult = ts_apiGetOpenFileName(tsFN)If fResult Thenrlngflags = tsFN.flagsGOFN = tsTrimNull(tsFN.strFile)ElseGOFN = NullMsgBox "您未选择"EndEnd IfEnd Function
Public Function GSFN( _Optional ByRef rlngflags As Long = 0&, _Optional ByVal strInitialDir As String = "", _Optional ByVal strFilter As String = "dwg文件 (*.dwg)" & vbNullChar & "*.dwg" _& vbNullChar & "All Files (*.*)" & vbNullChar & "*.*", _Optional ByVal lngFilterIndex As Long = 1, _Optional ByVal strDefaultExt As String = "", _Optional ByVal strFileName As String = "", _Optional ByVal strDialogTitle As String = "", _Optional ByVal fOpenFile As Boolean = False) As Variant
'On Error GoTo tsGetFileFromUser_ErrDim tsFN As tsFileNameDim strFileTitle As StringDim fResult As Boolean' Allocate string space for the returned strings.strFileName = Left(strFileName & String(256, 0), 256)strFileTitle = String(256, 0)' Set up the data structure before you call the functionWith tsFN.lStructSize = LenB(tsFN)'.hwndOwner = Application.hWndAccessApp.strFilter = strFilter.nFilterIndex = lngFilterIndex.strFile = strFileName.nMaxFile = Len(strFileName).strFileTitle = strFileTitle.nMaxFileTitle = Len(strFileTitle).strTitle = strDialogTitle.flags = rlngflags.strDefExt = strDefaultExt.strInitialDir = strInitialDir.hInstance = 0.strCustomFilter = String(255, 0).nMaxCustFilter = 255.lpfnHook = 0End WithfResult = ts_apiGetSaveFileName(tsFN)If fResult Thenrlngflags = tsFN.flagsGSFN = tsTrimNull(tsFN.strFile)ElseGSFN = NullMsgBox "您未保存"EndEnd IfEnd Function' Trim Nulls from a string returned by an API call.
Private Function tsTrimNull(ByVal strItem As String) As String
On Error GoTo tsTrimNull_ErrDim I As IntegerI = InStr(strItem, vbNullChar)If I > 0 ThentsTrimNull = Left(strItem, I - 1)ElsetsTrimNull = strItemEnd IftsTrimNull_End:On Error GoTo 0Exit FunctiontsTrimNull_Err:BeepMsgBox Err.Description, , "Error: " & Err.Number _& " in function basBrowseFiles.tsTrimNull"Resume tsTrimNull_EndEnd FunctionPublic Function GOFOLDER() As String
On Error GoTo Err_GOFOLDERDim x As LongPtr, bi As BROWSEINFO, dwIList As LongPtrDim szPath As String, wPos As IntegerWith bi'.hOwner = hWndAccessApp.lpszTitle = "请选择文件夹".ulFlags = BIF_RETURNONLYFSDIRSEnd WithdwIList = SHBrowseForFolder(bi)szPath = Space$(512)x = SHGetPathFromIDList(ByVal dwIList, ByVal szPath)If x ThenwPos = InStr(szPath, Chr(0))GOFOLDER = Left$(szPath, wPos - 1)ElseGOFOLDER = ""MsgBox "您未选择"EndEnd If
Exit_GOFOLDER:Exit Function
Err_GOFOLDER:MsgBox Err.Number & " - " & Err.DescriptionResume Exit_GOFOLDER
End Function
#Else
Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (lpofn As OPENFILENAME) As Long
Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (lpofn As OPENFILENAME) As Long
Declare Function SHBrowseForFolder Lib "SHELL32.DLL" (lpBrowseInfo As BROWSEINFO) As Long
Declare Function SHGetPathFromIDList Lib "SHELL32.DLL" (ByVal pidl As Long, ByVal pszPath As String) As Long
Public choice As String
Type OPENFILENAMElStructSize As LonghwndOwner As LonghInstance As LonglpstrFilter As StringlpstrCustomFilter As StringnMaxCustFilter As LongnFilterIndex As LonglpstrFile As StringnMaxFile As LonglpstrFileTitle As StringnMaxFileTitle As LonglpstrInitialDir As StringlpstrTitle As Stringflags As LongnFileOffset As IntegernFileExtension As IntegerlpstrDefExt As StringlCustData As LonglpfnHook As LonglpTemplateName As String
End Type
Public Type BROWSEINFOhOwner As LongpidlRoot As LongpszDisplayName As StringlpszTitle As StringulFlags As Longlpfn As LonglParam As LongiImage As Long
End TypeFunction GOFOLDER(Optional message) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, x As Long, pos As Integer
bInfo.pidlRoot = 0
bInfo.lpszTitle = ""
bInfo.ulFlags = &H1
x = SHBrowseForFolder(bInfo)
path = Space$(256)
r = SHGetPathFromIDList(ByVal x, ByVal path)
If r Thenpos = InStr(path, Chr(0))GOFOLDER = Left(path, pos - 1)
ElseGOFOLDER = ""MsgBox "您未选择"End
End If
End Function
Function GOFN() As StringDim sOFN As OPENFILENAMEWith sOFN.lStructSize = Len(sOFN).lpstrFilter = "dwg文件(*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & "dxf文件(*.dxf)" & Chr(0) & "*.dxf" & Chr(0) & "Excel文件(*.xl*)" & Chr(0) & "*.xl*" & Chr(0) & "Word文件(*.do*)" _& Chr(0) & "*.do*" & Chr(0) & "PPT文件(*.pp*)" & Chr(0) & "*.pp*" & Chr(0) & "所有文件(*.*)" & Chr(0) & "*.*" _& Chr(0) & Chr(0).lpstrFile = Space(1024).nMaxFile = 1025End WithDim sFileName As StringIf GetOpenFileName(sOFN) <> 0 ThenWith sOFNsFileName = Trim(.lpstrFile)GOFN = Left(sFileName, Len(sFileName) - 1)End WithElseGOFN = ""MsgBox "您已取消，请重新选择"EndEnd If
End Function
Function GSFN() As StringDim sSFN As OPENFILENAMEWith sSFN.lStructSize = Len(sSFN)'设置保存文件对话框中的文件筛选字符串对.lpstrFilter = "dwg文件(*.dwg)" & Chr(0) & "*.dwg" & Chr(0) & "dxf文件(*.dxf)" & Chr(0) & "*.dxf" & Chr(0) & "Excel文件(*.xl*)" & Chr(0) & "*.xl*" & Chr(0) & "Word文件(*.do*)" _& Chr(0) & "*.do*" & Chr(0) & "PPT文件(*.pp*)" & Chr(0) & "*.pp*" & Chr(0) & "所有文件(*.*)" & Chr(0) & "*.*" _& Chr(0) & Chr(0)'设置文件完整路径和文件名的缓冲区.lpstrFile = Space(1024)'设置文件完整路径和文件名的最大字符数,一定要比lpstrFile参数指定的字符数多1，用于存储结尾Null字符.nMaxFile = 1025End WithDim sFileName As StringIf GetSaveFileName(sSFN) <> 0 ThenWith sSFNsFileName = Trim(.lpstrFile)GSFN = Left(sFileName, Len(sFileName) - 1)End WithElseGSFN = ""MsgBox "您已取消，请重新选择"EndEnd If
'    Debug.Print GSFN, Len(GSFN)End Function
#End IfSub CAD打开excel_cadvba实现()
Dim excel As Object
Dim excelSheet As Object' Start ExcelOn Error Resume NextSet excel = GetObject(, "Excel.Application")If Err <> 0 ThenErr.ClearSet excel = CreateObject("Excel.Application")If Err <> 0 ThenMsgBox "Could not load Excel.", vbExclamationEndEnd IfEnd Ifexcel.Visible = True
'    MsgBox GOFNexcel.Workbooks.Open FileName:=GOFN
'    On Error GoTo errorcontrol
'errorcontrol: MsgBox Err.Number & " - " & Err.Description
'EndEnd Sub

本文来自互联网用户投稿，该文观点仅代表作者本人，不代表本站立场。本站仅提供信息存储空间服务，不拥有所有权，不承担相关法律责任。如若转载，请注明出处：http://www.mzph.cn/news/761785.shtml

如若内容造成侵权/违法违规/事实不符，请联系多彩编程网进行投诉反馈email:809451989@qq.com，一经查实，立即删除！

相关文章

实时数仓之实时数仓架构(Doris)

实时数仓之实时数仓架构(Doris)

目前比较流行的实时数仓架构有两类，其中一类是以Flink+Doris为核心的实时数仓架构方案；另一类是以湖仓一体架构为核心的实时数仓架构方案。本文针对Flink+Doris架构进行介绍，这套架构的特点是组件涉及相对较少，架构简单，实时性更高，且易于Lambda架构实现，Doris本身可以支…
阅读更多...
R语言Meta分析核心技术：回归诊断与模型验证

R语言Meta分析核心技术：回归诊断与模型验证

R语言作为一种强大的统计分析和绘图语言&#xff0c;在科研领域发挥着日益重要的作用。其中&#xff0c;Meta分析作为一种整合多个独立研究结果的统计方法&#xff0c;在R语言中得到了广泛的应用。通过R语言进行Meta分析&#xff0c;研究者能够更为准确、全面地评估某一研究问题…
阅读更多...
在OAK-D S2相机上应用ORB_SLAM3

在OAK-D S2相机上应用ORB_SLAM3

文章目录 ROS1 noetic + depthai_rosORB_SLAM3什么是ORB_SLAM3怎么安装运行ROS1 noetic + depthai_ros 目前X86和arch64平台测试安装包没有问题。 树莓派上安装ROS需要自己编译安装，时间比较长，需要测试的可以到 官网 查看，替换下面安装ROS步骤就可以了。 ubuntu20.04推荐…
阅读更多...
突破界面开发的边界：使用Fizzgui将Go语言和HTML/CSS相结合

突破界面开发的边界：使用Fizzgui将Go语言和HTML/CSS相结合

简洁与高效&#xff1a;使用Go-qt和Go-walk开发跨平台GUI应用程序的最佳选择 前言 在当今软件开发领域&#xff0c;图形用户界面&#xff08;GUI&#xff09;已经成为了几乎所有应用程序的标配。Go语言作为一门强大而灵活的编程语言&#xff0c;也提供了多种选择来开发图形界…
阅读更多...
安卓studio连接手机之后，一两秒之后就自动断开了。问题解决。

安卓studio连接手机之后，一两秒之后就自动断开了。问题解决。

太坑了&#xff0c;安卓studio链接手机之后。几秒之后就断开了。我以为是adb的问题&#xff0c;就重新安装了一下adb。并且在环境变量中配置了Path的路径。然而并没有什么用啊。 后来查看是wps的服务和ADB有冲突。直接把WPS卸载掉之后就没有出现链接手机闪现的的问题。
阅读更多...
基于python+vue研究生志愿填报辅助系统flask-django-php-nodejs

基于python+vue研究生志愿填报辅助系统flask-django-php-nodejs

二十一世纪我们的社会进入了信息时代&#xff0c;信息管理系统的建立&#xff0c;大大提高了人们信息化水平。传统的管理方式对时间、地点的限制太多&#xff0c;而在线管理系统刚好能满足这些需求&#xff0c;在线管理系统突破了传统管理方式的局限性。于是本文针对这一需求设…
阅读更多...
golang通过参数控制HTTP server是否使用基本认证

golang通过参数控制HTTP server是否使用基本认证

之前写的《golang实现一个BasicAuth的HTTP server》一定会做基本认证。 本例给出了如何通过启动时候指定的参数来控制是否做基本认证 代码对比和解释 给出与上一篇中源码的diff adminhpc-1:~/go/auth_http$ diff -ruN http_rpc_server.go_bak http_rpc_server.go --- http_rp…
阅读更多...
阿里云国际该如何设置DDoS高防防护策略？

阿里云国际该如何设置DDoS高防防护策略？

DDoS高防提供针对网络四层DDoS攻击的防护策略设置功能&#xff0c;例如虚假源和空连接检测、源限速、目的限速&#xff0c;适用于优化调整非网站业务的DDoS防护策略。在DDoS高防实例下添加端口转发规则&#xff0c;接入非网站业务后&#xff0c;您可以单独设置某个端口的DDoS防…
阅读更多...
Hive SQL必刷练习题：留存率问题（*****）

Hive SQL必刷练习题：留存率问题（*****）

留存率&#xff1a; 首次登录算作当天新增&#xff0c;第二天也登录了算作一日留存。可以理解为&#xff0c;在10月1号登陆了。在10月2号也登陆了&#xff0c;那这个人就可以算是在1号留存 今日留存率 &#xff08;今日登录且明天也登录的用户数&#xff09; / 今日登录的总…
阅读更多...
[Java安全入门]六.CC2+CC4+CC5+CC7

[Java安全入门]六.CC2+CC4+CC5+CC7

一.前言 与前面几条cc不同的是&#xff0c;cc2的依赖是4.0版本&#xff0c;并且解决了高版本无法使用AnnotationInvocationHandler类的弊端。cc2使用javassist和PriorityQueue来构造链。 二.添加依赖 <dependencies><!-- https://mvnrepository.com/artifact/common…
阅读更多...
读书笔记--阅读华为数据治理之旅有感

读书笔记--阅读华为数据治理之旅有感

通过阅读华为的数据治理之旅，了解到华为公司作为高科技企业的引领者，在数据治理工作、数字化智能化转型方面的确有许许多多值得大家学习的地方，华为公司的业务范围广泛，市场竞争压力大，迫切需要用一些高效的手段来减轻员工的工作量，让员工各司其职，在各自承担的主营业务…
阅读更多...
蓝桥杯STM32 G431 hal库开发速成——输入捕获

蓝桥杯STM32 G431 hal库开发速成——输入捕获

蓝桥杯的输入捕获较为简单&#xff0c;基本不涉及溢出的问题。所以这里就不介绍溢出了。文末有源码。 一、Cubemx配置 二、代码编写 1.在捕获回调函数中 void HAL_TIM_IC_CaptureCallback(TIM_HandleTypeDef *htim) {if(htim->InstanceTIM3){switch(count){case 1:{jishu1…
阅读更多...
数据分析-概率分布

数据分析-概率分布

概率分布 概率分布(Probability Distributions)离散概率分布伯努利分布(Bernoulli Distribution)二项分布(The Binomial distribution)泊松分布(Poisson Distribution) 连续概率分布均匀分布(Uniform Distribution)正态分布(Normal Distribution)指数分布&#xff08;Exponenti…
阅读更多...
Tailwind notes

Tailwind notes

flex flex - 使用Flexbox布局&#xff0c;这是一个非常灵活的布局模式&#xff0c;用于在容器内部以动态的方式对子项进行排列。justify-between - 在Flexbox布局中&#xff0c;这个类使容器中的子项之间的间距平均分布&#xff0c;首尾子项贴紧容器边界。items-center - 在Fl…
阅读更多...
Day20 Java常用类

Day20 Java常用类

Day20 Java常用类 一、String类 1、概念&#xff1a; 在Java中&#xff0c;String类是一个非常常用的类&#xff0c;用于表示字符串对象。String类提供了许多方法来操作和处理字符串。 2、String类常用方法&#xff1a; 获取字符串长度&#xff1a; int length(): 返回字符串…
阅读更多...
C#使用ASP.NET Core Razor Pages构建网站（一）

C#使用ASP.NET Core Razor Pages构建网站（一）

一、了解Web开发 Web开发就是使用HTTP&#xff08;超文本传输协议&#xff09;进行开发。 HTTP HTTP&#xff08;Hypertext Transfer Protocol&#xff09;是一种用于传输超文本和相关数据的应用层协议。它是Web上数据通信的基础&#xff0c;被用于从Web服务器传输到客户端浏…
阅读更多...
如何让uni-app开发的H5页面顶部原生标题和小程序的顶部标题不一致？

如何让uni-app开发的H5页面顶部原生标题和小程序的顶部标题不一致？

如何让标题1和标题2不一样&#xff1f; 修改根目录下的App.vue&#xff08;核心代码如下&#xff09; <script>export default {onLaunch() {// 监听各种跳转----------------------------------------[navigateTo, redirectTo, reLaunch, switchTab, navigateBack, ].…
阅读更多...
【JSON2WEB】10 基于 Amis 做个登录页面login.html

【JSON2WEB】10 基于 Amis 做个登录页面login.html

【JSON2WEB】01 WEB管理信息系统架构设计 【JSON2WEB】02 JSON2WEB初步UI设计 【JSON2WEB】03 go的模板包html/template的使用 【JSON2WEB】04 amis低代码前端框架介绍 【JSON2WEB】05 前端开发三件套 HTML CSS JavaScript 速成 【JSON2WEB】06 JSON2WEB前端框架搭建 【J…
阅读更多...
《云计算：数字时代的引擎》

《云计算：数字时代的引擎》

在数字化时代&#xff0c;云计算技术以其强大的计算能力和灵活的应用方式&#xff0c;成为推动各行各业发展的引擎。本文将围绕云计算的技术进展、技术原理、行业应用案例、面临的挑战与机遇以及未来趋势进行详细探讨。 云计算的技术进展 云计算的技术进展涵盖了多个方面&…
阅读更多...
AUTOSAR XML（通常称为ARXML）

AUTOSAR XML（通常称为ARXML）

AUTOSAR XML（通常称为ARXML） ARXML是一种基于XML（可扩展标记语言）的文件格式，用于在AUTOSAR（汽车开放系统架构）标准中描述汽车软件系统的各种元素。 ARXML文件包含软件组件、接口、数据类型和配置参数等信息，这些信息可以用于描述系统的功能和结构。ARXML文件的特点是…
阅读更多...
最新文章

Copyright @ 2022~2023