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

  显示原文与译文双语对照的内容
0 0

我正在进行的VBA代码generator/injector上添加到Excel VBA功能使用工作簿VBA Extensibility 。 这一切都可以正常工作。

然而,原始的代码注入使用条件编译,引用一些全局条件编译参数:

enter image description here

我有什么方法可以以编程方式modify/add的条件编译参数VBA项目?

我查过的所有属性VBProject但什么都找不到

时间:原作者:7个回答

0 0

启发 这种方式,下面通过SiddharthRout,我一直在找解决方案使用? SendMessageFindWindow:

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:TempSample.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

该对话框中的唯一方法产生任何操作都是通过 SendMessageapi函数,或者是, 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
原作者:
...