如何以编程方式更改 VBA 项目的条件编译属性

问题描述 投票:0回答:5

我目前正在开发一个 VBA 代码生成器/注入器,它通过使用 VBA 扩展性将 VBA 功能添加到 Excel 工作簿。这一切都很好。

但是,注入的原始代码使用了条件编译,参考了一些全局条件编译参数:

enter image description here

有什么方法可以以编程方式修改/添加 VBA 项目的条件编译参数吗?

我检查了 VBProject 的所有属性,但找不到任何内容。

vba excel properties conditional-compilation vbe
5个回答
14
投票

受到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

7
投票

对于 Access 2000,我使用:

Application.GetOption("Conditional Compilation Arguments")

为了获得,

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

用于设置。

仅此而已。


5
投票

影响该对话框中任何内容的唯一方法是通过

SendMessage
API 函数,或者可能是
Application.SendKeys
。您最好在代码中声明常量,如下所示:

#Const PACKAGE_1 = 0

然后让您的代码修改所有 VBA 组件的

CodeModule

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

2
投票

这是 2010 年后如何在 Access 中获取和设置多个参数:

设置他们,这是代码:

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

0
投票

在 Excel VBA Application.GetOption/SetOption 中不可用,因此我尝试了上面的详细代码。不幸的是线

xlApp.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute

引发错误。因此这个问题仍然没有解决方案。

© www.soinside.com 2019 - 2024. All rights reserved.