How to programmatically change conditional compilation properties of a VBA project

前端 未结 4 2145
梦毁少年i
梦毁少年i 2020-12-15 07:17

I\'m currently working on a VBA code generator/injector that adds VBA functionality to Excel workbooks by using the VBA Extensibility. This all works fine.

However,

相关标签:
4条回答
  • 2020-12-15 07:37

    Inspired by this approach, shown by SiddharthRout, I managed to find the following solution using SendMessage and 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
    
    0 讨论(0)
  • 2020-12-15 07:40

    The only way to affect anything in that dialog box is through SendMessage API functions, or maybe Application.SendKeys. You'd be better off declaring the constants in code, like this:

    #Const PACKAGE_1 = 0
    

    And then have your code modify the CodeModule of all your VBA components:

    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
    
    0 讨论(0)
  • 2020-12-15 07:53

    For Access 2000 I used:

    Application.GetOption("Conditional Compilation Arguments")
    

    for getting,

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

    for setting.

    That's all.

    0 讨论(0)
  • 2020-12-15 07:59

    This is how to get and set multiple arguments in Access after 2010:

    To set them this is the code:

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

    To get them:

    Application.GetOption("Conditional Compilation Arguments")
    

    They are printed like this: A = 4 : B = 10

    That is how to test it:

    Sub TestMe()
    
        #If A = 1 Then
            Debug.Print "a is 1"
        #Else
            Debug.Print "a is not 1"
        #End If
    
    End Sub
    
    0 讨论(0)
提交回复
热议问题