2013-11-01 2 views
15

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

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

enter image description here

Есть ли способ, что я могу программно изменить/добавить условные аргументы компиляции VBA проект?

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

+0

вы имеете в виду, как это? http://msdn.microsoft.com/en-us/library/aa240847%28v=vs.60%29.aspx –

+1

@SiddharthRout: Да - только то, что у меня не было бы никакого vb6.exe как его всего в Excel/VBA. –

+0

Этот код также совместим с VBA :) –

ответ

12

Вдохновленный this approach, проявленные 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 
+0

+ 1 Для поиска ответа самостоятельно :) –

+0

+1 для его решения –

5

Единственный способ повлиять на что-либо в этом диалоговом окне - через функции API SendMessage, или, может быть, 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 
+0

Спасибо за ответ - верный +1. К сожалению, это не помогает, так как я работаю в международной среде, поэтому «SendKeys» потерпит неудачу. И вся идея использования центральных аргументов условного компилятора заключалась в том, чтобы предотвратить множество операторов '# CONST' на наверху каждого модуля. :-( –

4

для Access 2000 Я нас изд:

Application.GetOption("Conditional Compilation Arguments") 

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

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

для установки.

Это все.

+0

Это работает и в более поздних версиях Access. – kismert

0

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

enter image description here

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

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 
Смежные вопросы