Excel VBA - определите, включен ли модуль в проект - PullRequest
0 голосов
/ 25 марта 2019

В настоящее время я работаю над проектом, в котором я не могу проверить, установлены ли все модули.Растет группа модулей, используемых для общих функций программ, с которыми я работаю.Я пробовал некоторые решения в Интернете, которые я не мог использовать, так как я не знаком с Activeworkbook.VBProject.VBComponents() методами.

Было упомянуто, что я должен проверить справочник по инструментам для Microsoft Visual Basic For Extensibility для приложений, и я проверил это безрезультатно.Любая помощь будет оценена.:)

Ссылки:

https://www.mrexcel.com/forum/excel-questions/284317-vba-function-check-if-particular-macro-exists.html

https://www.devhut.net/2010/12/09/ms-access-vba-determine-if-a-module-exists/

вот мой код:

Option Explicit

Public Function Is_Module_Loaded(name As String) As Boolean
    Dim Module As Object
    Dim Module_Name As String
    Module_Name = name
    Is_Module_Loaded = False


    On Error GoTo errload
        Set Module = ActiveWorkbook.VBProject.VBComponents(Module_Name).CodeModule

    Is_Module_Loaded = True

    If (0 <> 0) Then
errload:
        MsgBox ("MODULE: " & Module_Name & " is not installed please add")
        Stop
    End If

End Function

при запускеКодекс Я не получаю никакой ошибки, которая очень полезна, за исключением моей собственной, которая сообщает о неправильном сообщении, что мой модуль отсутствует, когда его нет.

Ответы [ 2 ]

1 голос
/ 25 марта 2019

РЕДАКТИРОВАТЬ: обновлено, чтобы добавить книгу в качестве второго параметра

Попробуйте это:

Sub tester()

    Debug.Print Is_Module_Loaded(ThisWorkbook, "Module4")
    Debug.Print Is_Module_Loaded(ActiveWorkbook, "Module4")

End sub


Public Function Is_Module_Loaded(wb as Workbook, name As String) As Boolean

    Dim Module As Object

    On Error Resume Next
    Set Module = wb.VBProject.VBComponents(name).CodeModule
    On Error GoTo 0

    Is_Module_Loaded = Not Module Is Nothing

    If Not Is_Module_Loaded Then
        MsgBox ("MODULE: " & name & " is not installed in '" & _
                wb.Name & "' please add")
    End If

End Function
0 голосов
/ 27 марта 2019

Так что я считаю, что нашел решение.

Кредит : Тим Уильямс, Матье Гиндон и Джо Пи (см. Ссылку) для руководства к решению

Ссылка : (https://stackoverflow.com/a/46727898/10297459)

Отмеченные проблемы: С оригинальным Тимом упоминалось, что если я не установил книгу, я мог сослаться на соответствующую книгу, это былоглавная проблема, поскольку у меня были открыты другие рабочие книги, на которые она пыталась ссылаться.

    Option Explicit

Public Function Is_Module_Loaded(name As String, Optional wb As Workbook) As Boolean 
'!!!need to reference: microsoft visual basic for applications extensibility 5.3
        Dim j As Long
        Dim vbcomp As VBComponent
        Dim modules As Collection
            Set modules = New Collection
        Is_Module_Loaded = False

    'check if value is set

        If wb Is Nothing Then
            Set wb = ThisWorkbook
        End If
        If (name = "") Then
            GoTo errorname
        End If

    'collect names of files
        For Each vbcomp In ThisWorkbook.VBProject.VBComponents

            If ((vbcomp.Type = vbext_ct_StdModule) Or (vbcomp.Type = vbext_ct_ClassModule)) Then
                modules.Add vbcomp.name
            End If

        Next vbcomp

    'Compair the file your looking for to the collection
        For j = 1 To modules.Count
            If (name = modules.Item(j)) Then
                Is_Module_Loaded = True
            End If
        Next j
        j = 0

    'if Is_module_loaded not true
        If (Is_Module_Loaded = False) Then
            GoTo notfound
        End If

    'if error
        If (0 <> 0) Then
errorname:
            MsgBox ("Function BootStrap.Is_Module_Loaded Was not passed a Name of Module")
            Stop
        End If
        If (0 <> 0) Then
notfound:
            MsgBox ("MODULE: " & name & " is not installed please add")
            Stop
        End If

End Function
...