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

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