Excel自动加载autocad 类型库/autocad 代码引用excel的类型库

复制代码
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
Sub AutoADDAutoCADTypeLib()
    Dim Ref    As Variant
    Dim hasAutoTypeLib    As Boolean , hasAXDBLib    As Boolean , acadName    As String
    hasAutoTypeLib =    False : hasAXDBLib =    False
    For Each Ref    In ThisWorkbook.VBProject.References
        If Ref.Name =    "AutoCAD" Then hasAutoTypeLib =    True
        If Ref.Name =    "AXDBLib" Then hasAXDBLib =    True
    Next Ref
    Dim wshell    As Object
    Set wshell = CreateObject(   "WScript.Shell" )
    Dim strAcadShardFd    As String , acadCurVer1    As String , acadCurVer2    As String , acadLanguage    As String
    '读取cad的版本
    acadCurVer1 = wshell.regread(   "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\CurVer" )
    '读取cad的语言版本
    acadCurVer2 = wshell.regread(   "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & " \CurVer")
    '读取cad的最后一次启动的语言版本
    acadLanguage = wshell.regread(   "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & " \   " & acadCurVer2 & " \AllUsersFolder")
    Dim LanguagePath    As Variant , acadVer    As String
    LanguagePath = VBA.Split(acadLanguage, "\")
    acadVer = VBA.Mid(acadCurVer1, 2, 2) & LanguagePath(UBound(LanguagePath) - 1)
    acadName = LanguagePath(UBound(LanguagePath) - 3)
    '读取cad的64位类型库的路径
    strAcadShardFd = wshell.regread(   "HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & " \   " & acadCurVer2 & " \AutodeskSharedFolder")
  
    '读取cad的32位类型库的路径
    'strAcad32ShardFd = wshell.regread("HKEY_CURRENT_USER\Software\Autodesk\AutoCAD\" & acadCurVer1 & "\" & acadCurVer2 & "\AutodeskShared32Folder")
  
    Set wshell =    Nothing
  
    If hasAutoTypeLib =    False Then
        ThisWorkbook.VBProject.References.AddFromFile (strAcadShardFd &    "acax" & acadVer &    ".tlb" )
        MsgBox acadName &    " AutoCAD Type Lib Already add to referecne scucces"
    Else
        MsgBox    "AutoCAD Type Lib Already add to referecne, no need add aagin"
    End If
    If hasAXDBLib =    False Then
        ThisWorkbook.VBProject.References.AddFromFile (strAcadShardFd &    "axdb" & acadVer &    ".tlb" )
        MsgBox acadName &    " AXDBLib Already add to referecne scucces"
    Else
        MsgBox    "AXDBLib Already add to referecne, no need add aagin"
    End If
End Sub

　

复制代码

 

 

 

 

 

 

 

补充AUTOCAD 代码添加excel等office程序的类型库的引用

名字转换

Public Function OfficeProgId2ExeName(ProgId As String) As String
    'Excel,C:\Program Files\Microsoft Office\Root\Office16\EXCEL.EXE
    'PowerPoint,C:\Program Files\Microsoft Office\Root\Office16\MSPPT.OLB
    'Word,C:\Program Files\Microsoft Office\Root\Office16\MSWORD.OLB
    Dim exeName As String
    Select Case VBA.UCase(ProgId)
        Case "EXCEL"
            exeName = "EXCEL.EXE"
        Case "WORD"
            exeName = "MSWORD.OLB"
            '        Case "OUTLOOK"
            '            exeName = "MSOUTL.OLB"
        Case "POWERPOINT"
            exeName = "MSPPT.OLB"
    End Select
    OfficeProgId2ExeName = exeName
End Function

 

获取office程序的安装路径

Public Function GetOfficeAppPath(Optional appName As String) As String
    Dim msofficeApp As Object, msofficeAppExePath As String
    Set msofficeApp = CreateObject(appName & ".Application")
    msofficeAppExePath = msofficeApp.Path & "\" & OfficeProgId2ExeName(appName)
    ': LibraryPath : "C:\Program Files\Microsoft Office\Root\Office16\LIBRARY" : String
    msofficeApp.Quit
    Set msofficeApp = Nothing
    GetOfficeAppPath = msofficeAppExePath
End Function

利用vbe添加office的引用

Public Sub AddOfficeReferenceLibray()
    Dim vbeObj As Object, ref As Object, hasExelReference As Boolean, msOfficeExePath As String, msOfficeref As Object
    msOfficeExePath = GetOfficeAppPath("EXCEL")
    Set vbeObj = Application.vbe
    For Each ref In vbeObj.ActiveVBProject.References
        If VBA.StrComp(ref.fullPath, msOfficeExePath, vbTextCompare) = 0 Then
            hasExelReference = True
            Exit For
        End If
    Next
    If hasExelReference = False Then
        Set msOfficeref = vbeObj.ActiveVBProject.References.AddFromFile(msOfficeExePath)
    End If
    If Not (msOfficeref Is Nothing) Then Set msOfficeref = Nothing
    If Not (vbeObj Is Nothing) Then Set vbeObj = Nothing
End Sub

 

取消office的类型的引用

Public Sub RemovedOfficeReferenceLibray()
    Dim vbeObj As Object, ref As Object, hasExelReference As Boolean, msOfficeExePath As String, msOfficeref As Object
    msOfficeExePath = GetOfficeAppPath("EXCEL")
    Set vbeObj = Application.vbe
    For Each ref In vbeObj.ActiveVBProject.References
        'Debug.Print ref.Name & "," & ref.fullPath
        If VBA.StrComp(ref.fullPath, msOfficeExePath, vbTextCompare) = 0 Then
            'If VBA.StrComp(ref.Name, msOfficeExePath, vbBinaryCompare) = 0 Then
            hasExelReference = True
            Set msOfficeref = ref
            Exit For
        End If
    Next
    If hasExelReference = True Then
        Call vbeObj.ActiveVBProject.References.Remove(msOfficeref)
    End If
    If Not (msOfficeref Is Nothing) Then Set msOfficeref = Nothing
    If Not (vbeObj Is Nothing) Then Set vbeObj = Nothing
End Sub
posted @   南胜NanSheng  阅读(1392)  评论(0)  编辑  收藏  举报
编辑推荐：
· 从 HTTP 原因短语缺失研究 HTTP/2 和 HTTP/3 的设计差异
· AI与.NET技术实操系列：向量存储与相似性搜索在 .NET 中的实现
· 基于Microsoft.Extensions.AI核心库实现RAG应用
· Linux系列：如何用heaptrack跟踪.NET程序的非托管内存泄露
· 开发者必知的日志记录最佳实践
阅读排行：
· winform 绘制太阳，地球，月球 运作规律
· 超详细：普通电脑也行Windows部署deepseek R1训练数据并当服务器共享给他人
· TypeScript + Deepseek 打造卜卦网站：技术与玄学的结合
· AI 智能体引爆开源社区「GitHub 热点速览」
· 写一个简单的SQL生成工具
点击右上角即可分享
微信分享提示