cad vba 打开excel并弹窗打开指定文件、通过fso弹窗打开dwg

2024-03-25 12:12
文章标签 excel 指定 打开 cad vba 弹窗 dwg fso

本文主要是介绍cad vba 打开excel并弹窗打开指定文件、通过fso弹窗打开dwg，希望对大家解决编程问题提供一定的参考价值，需要的开发者们随着小编来一起学习吧！

 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

若不想通过windows api方法 （代码太长），可通过引用office库，调用excel的fso函数弹窗返回路径名，然后可通过documents.open打开dwg文件。

Function cad引用打开dwg()
'前提是：工具——引用——打开Microsoft office库
'On Error Resume Next
Dim excel As Object
'Set scripting.filesystemobject = GetObject(, "scripting.filesystemobject.Application")Set excel = CreateObject("excel.Application")
'excel.Visible = True
excel.workbooks.Add
With excel.FileDialog(msoFileDialogOpen).Title = "请选择你要的文件".AllowMultiSelect = True.InitialFileName = "C:\Users\Administrator\Desktop\".Filters.Clear.Filters.Add "excel files", "*.xls,*.xlsx,*.dwg"If .show = True ThenSet gof = .SelectedItems
'    .Execute '打开excel时启用Dim sname As Stringsname = gof.Item(1)Documents.Open snameexcel.Quit '退出excelElse: Exit FunctionEnd If
End With
End FunctionSub a()
Call cad引用打开dwg
ZoomExtents
ThisDrawing.Regen acActiveViewport
End Sub

cad引用打开excel方法：

Function cad引用打开excel()
'前提是：工具——引用——打开Microsoft office库
'On Error Resume Next
Dim excel As Object
'Set scripting.filesystemobject = GetObject(, "scripting.filesystemobject.Application")Set excel = CreateObject("excel.Application")
excel.Visible = True
excel.workbooks.Add
With excel.FileDialog(msoFileDialogOpen).Title = "请选择你要的文件".AllowMultiSelect = True.InitialFileName = "C:\Users\Administrator\Desktop\".Filters.Clear.Filters.Add "excel files", "*.xls,*.xlsx,*.dwg"If .show = True ThenSet gof = .SelectedItems.Execute '打开excel时启用
'    Dim sname As String
'    sname = gof.Item(1)
'    Documents.Open sname
'    excel.Quit '退出excelElse: Exit FunctionEnd If
End With
End FunctionSub a()
Call cad引用打开excel
End Sub

这篇关于cad vba 打开excel并弹窗打开指定文件、通过fso弹窗打开dwg的文章就介绍到这儿，希望我们推荐的文章对编程师们有所帮助！


http://www.chinasem.cn/article/844975。

相关文章

SQL Server配置管理器无法打开的四种解决方法

SQL Server配置管理器无法打开的四种解决方法

《SQLServer配置管理器无法打开的四种解决方法》本文总结了SQLServer配置管理器无法打开的四种解决方法,文中通过图文示例介绍的非常详细,对大家的学习或者工作具有一定的参考学习价值,需要的... 目录方法一：桌面图标进入方法二：运行窗口进入检查版本号对照表php方法三：查找文件路径方法四：检查 S
阅读更多...
Java easyExcel实现导入多sheet的Excel

Java easyExcel实现导入多sheet的Excel

《JavaeasyExcel实现导入多sheet的Excel》这篇文章主要为大家详细介绍了如何使用JavaeasyExcel实现导入多sheet的Excel,文中的示例代码讲解详细,感兴趣的小伙伴可... 目录1.官网2.Excel样式3.代码1.官网easyExcel官网2.Excel样式3.代码
阅读更多...
Golang如何对cron进行二次封装实现指定时间执行定时任务

Golang如何对cron进行二次封装实现指定时间执行定时任务

《Golang如何对cron进行二次封装实现指定时间执行定时任务》：本文主要介绍Golang如何对cron进行二次封装实现指定时间执行定时任务问题,具有很好的参考价值,希望对大家有所帮助,如有错误... 目录背景cron库下载代码示例【1】结构体定义【2】定时任务开启【3】使用示例【4】控制台输出总结背景
阅读更多...
springboot项目打jar制作成镜像并指定配置文件位置方式

springboot项目打jar制作成镜像并指定配置文件位置方式

《springboot项目打jar制作成镜像并指定配置文件位置方式》：本文主要介绍springboot项目打jar制作成镜像并指定配置文件位置方式,具有很好的参考价值,希望对大家有所帮助,如有错误... 目录一、上传jar到服务器二、编写dockerfile三、新建对应配置文件所存放的数据卷目录四、将配置文
阅读更多...
python3如何找到字典的下标index、获取list中指定元素的位置索引

python3如何找到字典的下标index、获取list中指定元素的位置索引

《python3如何找到字典的下标index、获取list中指定元素的位置索引》：本文主要介绍python3如何找到字典的下标index、获取list中指定元素的位置索引问题,具有很好的参考价值,... 目录enumerate()找到字典的下标 index获取list中指定元素的位置索引总结enumerat
阅读更多...
Java Web实现类似Excel表格锁定功能实战教程

Java Web实现类似Excel表格锁定功能实战教程

《JavaWeb实现类似Excel表格锁定功能实战教程》本文将详细介绍通过创建特定div元素并利用CSS布局和JavaScript事件监听来实现类似Excel的锁定行和列效果的方法,感兴趣的朋友跟随... 目录1. 模拟Excel表格锁定功能2. 创建3个div元素实现表格锁定2.1 div元素布局设计2.
阅读更多...
MySQL 打开binlog日志的方法及注意事项

MySQL 打开binlog日志的方法及注意事项

《MySQL打开binlog日志的方法及注意事项》本文给大家介绍MySQL打开binlog日志的方法及注意事项,本文通过实例代码给大家介绍的非常详细,对大家的学习或工作具有一定的参考借鉴价值,需要... 目录一、默认状态二、如何检查 binlog 状态三、如何开启 binlog3.1 临时开启（重启后失效）
阅读更多...
Java实现删除文件中的指定内容

Java实现删除文件中的指定内容

《Java实现删除文件中的指定内容》在日常开发中,经常需要对文本文件进行批量处理,其中,删除文件中指定内容是最常见的需求之一,下面我们就来看看如何使用java实现删除文件中的指定内容吧... 目录1. 项目背景详细介绍2. 项目需求详细介绍2.1 功能需求2.2 非功能需求3. 相关技术详细介绍3.1 Ja
阅读更多...
Python pip下载包及所有依赖到指定文件夹的步骤说明

Python pip下载包及所有依赖到指定文件夹的步骤说明

《Pythonpip下载包及所有依赖到指定文件夹的步骤说明》为了方便开发和部署,我们常常需要将Python项目所依赖的第三方包导出到本地文件夹中,：本文主要介绍Pythonpip下载包及所有依... 目录步骤说明命令格式示例参数说明离线安装方法注意事项总结要使用pip下载包及其所有依赖到指定文件夹，请按照以
阅读更多...
C#实现将Office文档(Word/Excel/PDF/PPT)转为Markdown格式

C#实现将Office文档(Word/Excel/PDF/PPT)转为Markdown格式

《C#实现将Office文档(Word/Excel/PDF/PPT)转为Markdown格式》Markdown凭借简洁的语法、优良的可读性,以及对版本控制系统的高度兼容性,逐渐成为最受欢迎的文档格式... 目录为什么要将文档转换为 Markdown 格式使用工具将 Word 文档转换为 Markdown（.
阅读更多...

Copyright China编程 23002807@qq.com

沪ICP备2023033072号-2