在64位cad中用VBA使用通用对话框(CommonDialog)的方法

zzyong00

大家知道，在64位cad中用VBA使用系统自带通用对话框(CommonDialog)控件是用不了的，因为这个控件是32位的，64位cad不能使用32位的控件和dll,本人采用activex exe方法，实现了在64位的环境中用VBA对通用对话框进行调用！
首先下载我编写的这个activex exe:,解压，放在任意一个你愿意的文件夹下，
然后，在AutoCAD中打开vba编辑器，把下面的代码复制进编辑器：

1. Private Sub ss1()
   
2. Dim x As New ZZYCommonDialog
   
3. Dim bC As Boolean, lFSC As Long, strF() As String, sLD As String
   
4.     x.ShowOpen ThisDrawing.Application.HWND32, bC, lFSC, strF, sLD'ThisDrawing.Application.HWND32，如果出错，用0代替
   
5. 
   
6.     Debug.Print bC
   
7.     If Not bC Then
   
8.         Debug.Print lFSC
   
9.         Debug.Print strF(0)
   
10.         Debug.Print sLD
    
11.     End If
    
12.     Set x = Nothing
    
13. End Sub
    
14. 
    
15. Private Sub ss2()
    
16. Dim x As New ZZYCommonDialog
    
17. Dim bC As Boolean, oC As OLE_COLOR
    
18.     x.ShowColor ThisDrawing.Application.HWND32, bC, oC
    
19.     Debug.Print bC
    
20.     Debug.Print oC
    
21. 
    
22.     Set x = Nothing
    
23. End Sub
    
24. Private Sub ss3()
    
25. Dim x As New ZZYCommonDialog
    
26. Dim Canceled As Boolean, SelectedFont As String, Bold As Boolean, Italic As Boolean, Size As Integer, Underline As Boolean, StrikeOut As Boolean, Color As Long, FaceName As String
    
27. 
    
28.     x.ShowFont ThisDrawing.Application.HWND32, Canceled, SelectedFont, Bold, Italic, Size, Underline, StrikeOut, Color, FaceName
    
29. 
    
30.     Debug.Print Canceled, SelectedFont, Bold, Italic, Size, Underline, StrikeOut, Color, FaceName
    
31.     Set x = Nothing
    
32. End Sub
    
33. Private Sub ss4()
    
34. Dim x As New ZZYCommonDialog
    
35. Dim bC As Boolean, lFSC As Long, strF As String, sLD As String
    
36.     x.ShowSave ThisDrawing.Application.HWND32, bC, lFSC, strF, sLD
    
37.     Debug.Print bC
    
38.     Debug.Print lFSC
    
39.     Debug.Print strF
    
40.     Debug.Print sLD
    
41.     Set x = Nothing
    
42. End Sub
    

Private Sub ss1()<br /> Dim x As New ZZYCommonDialog<br /> Dim bC As Boolean, lFSC As Long, strF() As String, sLD As String<br />     x.ShowOpen ThisDrawing.Application.HWND32, bC, lFSC, strF, sLD'ThisDrawing.Application.HWND32，如果出错，用0代替<br /> <br />     Debug.Print bC<br />     If Not bC Then<br />         Debug.Print lFSC<br />         Debug.Print strF(0)<br />         Debug.Print sLD<br />     End If<br />     Set x = Nothing<br /> End Sub<br /> <br /> Private Sub ss2()<br /> Dim x As New ZZYCommonDialog<br /> Dim bC As Boolean, oC As OLE_COLOR<br />     x.ShowColor ThisDrawing.Application.HWND32, bC, oC<br />     Debug.Print bC<br />     Debug.Print oC<br /> <br />     Set x = Nothing<br /> End Sub<br /> Private Sub ss3()<br /> Dim x As New ZZYCommonDialog<br /> Dim Canceled As Boolean, SelectedFont As String, Bold As Boolean, Italic As Boolean, Size As Integer, Underline As Boolean, StrikeOut As Boolean, Color As Long, FaceName As String<br /> <br />     x.ShowFont ThisDrawing.Application.HWND32, Canceled, SelectedFont, Bold, Italic, Size, Underline, StrikeOut, Color, FaceName<br /> <br />     Debug.Print Canceled, SelectedFont, Bold, Italic, Size, Underline, StrikeOut, Color, FaceName<br />     Set x = Nothing<br /> End Sub<br /> Private Sub ss4()<br /> Dim x As New ZZYCommonDialog<br /> Dim bC As Boolean, lFSC As Long, strF As String, sLD As String<br />     x.ShowSave ThisDrawing.Application.HWND32, bC, lFSC, strF, sLD<br />     Debug.Print bC<br />     Debug.Print lFSC<br />     Debug.Print strF<br />     Debug.Print sLD<br />     Set x = Nothing<br /> End Sub<br />

再然后，点击VBA编辑器的菜单，“工具”-》“引用”，

出来以下对话框，再点“浏览”，然后出现如下对话框 ，找到刚才你解压的附件的文件夹，选择那个文件“ZZYCommonDialogForVBAx64.exe”（扩展名是exe，不要害怕，是activex exe，Word,excel也是这样的程序）

点“打开”，点“确定”。

如果没有任何提示，恭喜你，你引用成功了，接下来，按F5运行哪几个测试代码就行了，
其中ss1是测试“打开”对话框的，ss2是测试“选择颜色”对话框的,其它自己试吧!

有人试用了，说不支持过滤文件扩展名，所以增加一下这个功能，出个升级版，同时，原版免币！－－－－－－－－－－－－－－－－－－
2018-06-16更新一下，支持选择多个文件，

flytomato

我试了，显示
运行时错误‘429’
Activex部件不能创建对象

月神的赐福

craig_tao 发表于 2017-11-28 15:57
楼主，您好
我在运行您的程序时发生错误：
运行时错误“438” 对象不支持该属性和方法，请问这是怎么回事 ...

好像是代码里 "ThisDrawing.Application.HWND32"的问题，如果改成"0"的话可以运行成功，但是打开的颜色窗口在左上角，无法操作，不知道楼主这个该怎么解决？

zzyong00

vbslope 发表于 2020-3-25 17:44
你好
“首先下载我编写的这个activex exe:,解压，放在任意一个你愿意的文件夹下”
如果自己编了一个引用 ...

https://blog.csdn.net/hmm1208/article/details/25836837
看一下这篇文章，了解一下activex组件的注册。
原则上，放在任何文件夹下都可以，但需要注册到注册表里

zzyong00

来个gif演示

yuanziyou

还在只有楼主活跃在vba版了

yucc

前几天才把这个问题搞定，VB在64位下，也无法添加这个部件，现在搞定了

zzyong00

yucc 发表于 2016-1-28 22:06
前几天才把这个问题搞定，VB在64位下，也无法添加这个部件，现在搞定了

搞定什么 了

yucc

zzyong00 发表于 2016-1-28 22:22
搞定什么 了

可以是这个部件了

3xxx

哇，这个厉害。我赶紧试试。

o_wild

谢谢。不过还没有完全替代commondialog的功能，比如文件对话框的扩展名过滤，怎么搞？

zzyong00

o_wild 发表于 2016-6-12 17:42
谢谢。不过还没有完全替代commondialog的功能，比如文件对话框的扩展名过滤，怎么搞？

已增加扩展名过滤，见一楼