我目前正在开发一个 VBA 代码生成器/注入器,它通过使用 VBA 可扩展性将 VBA 功能添加到 Excel 工作簿。这一切都很好。
但是,注入的原始代码使用条件编译,指的是一些全局条件编译参数:
有什么方法可以以编程方式修改/添加 VBA 项目的条件编译参数?
我检查了 VBProject 的所有属性,但找不到任何东西。
我目前正在开发一个 VBA 代码生成器/注入器,它通过使用 VBA 可扩展性将 VBA 功能添加到 Excel 工作簿。这一切都很好。
但是,注入的原始代码使用条件编译,指的是一些全局条件编译参数:
有什么方法可以以编程方式修改/添加 VBA 项目的条件编译参数?
我检查了 VBProject 的所有属性,但找不到任何东西。
受SiddharthRout 展示的这种方法的启发,我设法使用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
对于 Access 2000,我使用了:
Application.GetOption("Conditional Compilation Arguments")
为了得到,
Application.SetOption("Conditional Compilation Arguments", "<arguments>")
用于设置。
就这样。
影响该对话框中任何内容的唯一方法是通过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
这是 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