Как программно изменить свойства условной компиляции проекта VBA

В настоящее время я работаю над генератором/инжектором кода VBA, который добавляет функциональность VBA к книгам Excel с помощью VBA Extensibility. Все это прекрасно работает.

Однако исходный код, который вводится, использует условную компиляцию, ссылаясь на некоторые глобальные аргументы условной компиляции:

Можно ли каким-либо образом программно изменить/добавить аргументы условной компиляции проекта VBA?

Я проверил все свойства VBProject, но ничего не нашел.

Ответ 1

Вдохновленный этот подход, показанный SiddharthRout, мне удалось найти следующее решение, используя SendMessage и FindWindow:

Option Explicit

Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
(ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, _
ByVal lpsz2 As String) As Long

Private Declare Function GetWindowText Lib "user32" Alias "GetWindowTextA" _
(ByVal hwnd As Long, ByVal lpString As String, ByVal cch As Long) As Long

Private Declare Function GetWindowTextLength Lib "user32" Alias _
"GetWindowTextLengthA" (ByVal hwnd As Long) As Long

Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Const WM_SETTEXT = &HC
Const BM_CLICK = &HF5


Public Sub subSetconditionalCompilationArguments()
    Dim strArgument As String
    Dim xlApp As Object
    Dim wbTarget As Object

    Dim lngHWnd As Long, lngHDialog As Long
    Dim lngHEdit As Long, lngHButton As Long

    strArgument = "PACKAGE_1 = 1"

    Set xlApp = CreateObject("Excel.Application")
    xlApp.Visible = False

    Set wbTarget = xlApp.Workbooks.Open("C:\Temp\Sample.xlsb")

    'Launch the VBA Project Properties Dialog
    xlApp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

    'Get the handle of the "VBAProject" Window
    lngHWnd = FindWindow("#32770", vbNullString)
    If lngHWnd = 0 Then
        MsgBox "VBAProject Property Window not found!"
        GoTo Finalize
    End If

    'Get the handle of the dialog
    lngHDialog = FindWindowEx(lngHWnd, ByVal 0&, "#32770", vbNullString)
    If lngHDialog = 0 Then
        MsgBox "VBAProject Property Window could not be accessed!"
        GoTo Finalize
    End If

    'Get the handle of the 5th edit box
    lngHEdit = fctLngGetHandle("Edit", lngHDialog, 5)
    If lngHEdit = 0 Then
        MsgBox "Conditional Compilation Arguments box could not be accessed!"
        GoTo Finalize
    End If

    'Enter new argument
    SendMessage lngHEdit, WM_SETTEXT, False, ByVal strArgument

    DoEvents

    'Get the handle of the second button box (=OK button)
    lngHButton = fctLngGetHandle("Button", lngHWnd)
    If lngHButton = 0 Then
        MsgBox "Could not find OK button!"
        GoTo Finalize
    End If

    'Click the OK Button
    SendMessage lngHButton, BM_CLICK, 0, vbNullString

Finalize:
    xlApp.Visible = True
    'Potentially save the file and close the app here
End Sub

Private Function fctLngGetHandle(strClass As String, lngHParent As Long, _
    Optional Nth As Integer = 1) As Long
    Dim lngHandle As Long
    Dim i As Integer

    lngHandle = FindWindowEx(lngHParent, ByVal 0&, strClass, vbNullString)
    If Nth = 1 Then GoTo Finalize

    For i = 2 To Nth
        lngHandle = FindWindowEx(lngHParent, lngHandle, strClass, vbNullString)
    Next
Finalize:
    fctLngGetHandle = lngHandle
End Function

Ответ 2

Единственный способ повлиять на что-либо в этом диалоговом окне - через функции SendMessage API, или, возможно, Application.SendKeys. Вам было бы лучше объявить константы в коде, например:

#Const PACKAGE_1 = 0

И затем измените код CodeModule всех ваших компонентов VBA:

Dim comp As VBComponent
For Each comp In ThisWorkbook.VBProject.VBComponents
    With comp.CodeModule
        Dim i As Long
        For i = 1 To .CountOfLines
            If Left$(.Lines(i, 1), 18) = "#Const PACKAGE_1 =" Then
                .ReplaceLine i, "#Const PACKAGE_1 = 1"
            End If
        Next i
    End With
Next comp

Ответ 3

Для Access 2000 я использовал:

Application.GetOption("Conditional Compilation Arguments")

для получения,

Application.SetOption("Conditional Compilation Arguments", "<arguments>")

для настройки.

Что все.

Ответ 4

Вот как получить и установить несколько аргументов в Access после 2010 года:

Чтобы установить, это код:

application.SetOption "Conditional Compilation Arguments","A=4:B=10"

Чтобы получить их:

Application.GetOption("Conditional Compilation Arguments")

Они печатаются следующим образом: A = 4 : B = 10

Вот как это проверить:

Sub TestMe()

    #If A = 1 Then
        Debug.Print "a is 1"
    #Else
        Debug.Print "a is not 1"
    #End If

End Sub