ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

快捷登录

搜索
EH技术汇-专业的职场技能充电站 妙哉!函数段子手趣味讲函数 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
HR薪酬管理数字化实战 Excel 2021函数公式学习大典 Excel数据透视表实战秘技 打造核心竞争力的职场宝典
300集Office 2010微视频教程 数据工作者的案头书 免费直播课集锦 ExcelHome出品 - VBA代码宝免费下载
用ChatGPT与VBA一键搞定Excel WPS表格从入门到精通 Excel VBA经典代码实践指南
查看: 8115|回复: 14

[求助] 如何用代码 提取工程引用→可使用的引用列表

[复制链接]

TA的精华主题

TA的得分主题

发表于 2016-10-18 23:51 | 显示全部楼层 |阅读模式
本帖已被收录到知识树中,索引项:注册表
如何用代码 提取工程引用→可使用的引用列表

TA的精华主题

TA的得分主题

发表于 2016-10-18 23:55 来自手机 | 显示全部楼层
说什么列表?

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-10-19 00:05 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
就是 VBA工具 引用窗口底下可使用的引用 的项目列表

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-10-19 00:09 | 显示全部楼层
本帖最后由 百日筑基 于 2016-10-19 00:11 编辑

C:\Users\hsensixj\Desktop
QQ图片20161019000851.png

TA的精华主题

TA的得分主题

发表于 2016-10-19 06:49 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-10-19 09:30 | 显示全部楼层

TA的精华主题

TA的得分主题

发表于 2016-10-19 10:19 | 显示全部楼层
Sub VBProjectReferences()
    Dim n As Integer
    With ThisWorkbook.VBProject.References
        For n = 1 To .Count
            Cells(n, 1) = .Item(n).Description
        Next n
    End With
End Sub

TA的精华主题

TA的得分主题

 楼主| 发表于 2016-10-19 10:40 | 显示全部楼层
本帖最后由 百日筑基 于 2016-10-19 10:41 编辑

您好,首先感谢您的帮助,我主要想获取的是没有勾选的部分信息,我的目的是想提前获知我的电脑上面安装了哪几个版本的CAD软件

TA的精华主题

TA的得分主题

发表于 2016-10-19 11:20 | 显示全部楼层
Option Explicit
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const KEY_READ As Long = (( _
                  STANDARD_RIGHTS_READ _
               Or KEY_QUERY_VALUE _
               Or KEY_ENUMERATE_SUB_KEYS _
               Or KEY_NOTIFY) _
               And (Not SYNCHRONIZE))
Private Const ERROR_SUCCESS As Long = 0&
Private Const ERROR_NO_MORE_ITEMS As Long = 259&
Private Declare Function RegOpenKeyEx _
   Lib "advapi32.dll" Alias "RegOpenKeyExA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal ulOptions As Long, _
        ByVal samDesired As Long, _
        ByRef phkResult As Long) As Long
Private Declare Function RegEnumKey _
   Lib "advapi32.dll" Alias "RegEnumKeyA" ( _
        ByVal hKey As Long, _
        ByVal dwIndex As Long, _
        ByVal lpName As String, _
        ByVal cbName As Long) As Long
Private Declare Function RegQueryValue _
   Lib "advapi32.dll" Alias "RegQueryValueA" ( _
        ByVal hKey As Long, _
        ByVal lpSubKey As String, _
        ByVal lpValue As String, _
        ByRef lpcbValue As Long) As Long
Private Declare Function RegCloseKey _
   Lib "advapi32.dll" ( _
        ByVal hKey As Long) As Long
Private Sub RefList()
Dim R1 As Long
Dim R2 As Long
Dim hHK1 As Long
Dim hHK2 As Long
Dim hHK3 As Long
Dim hHK4 As Long
Dim i As Long
Dim i2 As Long
Dim lpPath As String
Dim lpGUID As String
Dim lpName As String
Dim lpValue As String
    Cells.Clear
    lpPath = String$(128, vbNullChar)
   lpValue = String$(128, vbNullChar)
   lpName = String$(128, vbNullChar)
   lpGUID = String$(128, vbNullChar)
    R1 = RegOpenKeyEx(HKEY_CLASSES_ROOT, "TypeLib", ByVal 0&, KEY_READ, hHK1)
   If R1 = ERROR_SUCCESS Then
       i = 0
       Do While Not R1 = ERROR_NO_MORE_ITEMS
           R1 = RegEnumKey(hHK1, i, lpGUID, Len(lpGUID))
           If R1 = ERROR_SUCCESS Then
               R2 = RegOpenKeyEx(hHK1, lpGUID, ByVal 0&, KEY_READ, hHK2)
               If R2 = ERROR_SUCCESS Then
                   i2 = 0
                   Do While Not R2 = ERROR_NO_MORE_ITEMS
                       R2 = RegEnumKey(hHK2, i2, lpName, Len(lpName)) '1.0
                       If R2 = ERROR_SUCCESS Then
                           RegQueryValue hHK2, lpName, lpValue, Len(lpValue)
                           RegOpenKeyEx hHK2, lpName, ByVal 0&, KEY_READ, hHK3
                           RegOpenKeyEx hHK3, "0", ByVal 0&, KEY_READ, hHK4
                           RegQueryValue hHK4, "win32", lpPath, Len(lpPath)
                           i2 = i2 + 1
                            Cells(i + 1, 1) = lpGUID
                           Cells(i + 1, 2) = lpValue
                           Cells(i + 1, 3) = lpPath
                       End If
                   Loop
               End If
           End If
           i = i + 1
       Loop
       RegCloseKey hHK1
       RegCloseKey hHK2
       RegCloseKey hHK3
       RegCloseKey hHK4
   End If
   Columns("A:A").EntireColumn.AutoFit
   Columns("B:C").ColumnWidth = 70
   Range("A1").CurrentRegion.Sort Key1:=Range("B1")
End Sub

TA的精华主题

TA的得分主题

发表于 2016-10-19 11:40 | 显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用  · 内置多项VBA编程加强工具       ★ 免费下载 ★      ★使用手册
lxb1117 发表于 2016-10-19 11:20
Option Explicit
Private Const HKEY_CLASSES_ROOT As Long = &H80000000
Private Const READ_CONTROL As ...

多谢分享,能否修改为只提取autocad的引用对象吗
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2024-4-25 08:28 , Processed in 0.042116 second(s), 9 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2023 Wooffice Inc.

沪公网安备 31011702000001号 沪ICP备11019229号-2

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:李志群律师

快速回复 返回顶部 返回列表