Parameter - Variable nach Word an ein Makro übergeben...

Frage: Immer wieder taucht die Frage auf, wie man Parameter bzw. eine Variable aus einem Makro in Excel an einen Code in einer Worddatei mitgeben kann, damit mit den Werten weitergerechnet bzw. Texte übernommen werden können.

Hier noch eine Beispieldatei: Parameter - Variable nach Word an ein Makro übergeben... - Zip-Datei mit der Excel- und Worddatei.

Hinweise, wie man Fenster in den Vordergrund holen kann:
Fenster in den Vordergrund...

Option Explicit
Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" _
    (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Private Declare Function SetForegroundWindow Lib "user32" _
    (ByVal hWnd As Long) As Long
Private Declare Function GetWindowThreadProcessId Lib "user32.dll" _
    (ByVal hWnd As Long, ByRef lpdwProcessId As Long) As Long
Private Declare Function AllowSetForegroundWindow Lib "user32.dll" _
    (ByVal dwProcessId As Long) As Long
Private Declare Function ShowWindow Lib "user32.dll" _
    (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Private Const GC_CLASSNAMEWORD = "OpusApp"
Private Const SW_MAXIMIZE = 3
Dim blnTMP As Boolean
'-------------------------------------------------------------------------- 
' Module    : Modul1 
' Procedure : Main 
' Author    : Case (Ralf Stolzenburg) 
' Date      : 08.11.2012 
' Purpose   : Parameter / Variable nach Word übergeben... 
'-------------------------------------------------------------------------- 
Public Sub Main()
    Dim lngProcessID As Long
    Dim objApp As Object
    Dim strTMP As String
    Dim lngHwnd As Long
    Dim lngTMP As Long
    On Error GoTo Fin
    lngTMP = Tabelle1.Range("A1").Value
    strTMP = Tabelle1.Range("B1").Value
    Set objApp = OffApp("Word")
    ' Folgende Zeile auskommentieren für Word NICHT sichtbar 
    'Set objApp = OffApp("Word", False) 
    If Not objApp Is Nothing Then
        lngHwnd = FindWindow(GC_CLASSNAMEWORD, vbNullString)
        lngProcessID = GetWindowThreadProcessId(lngHwnd, ByVal 0&)
        Call AllowSetForegroundWindow(lngProcessID)
        Call SetForegroundWindow(lngHwnd)
        Call ShowWindow(lngHwnd, SW_MAXIMIZE)
        With objApp
            .Documents.Open ThisWorkbook.Path & _
                Application.PathSeparator & "Parameter.doc"
            .Run "Test", lngTMP, strTMP
    End With
    Else
        MsgBox "Applikation nicht installiert!"
    End If
Fin:
    If Not objApp Is Nothing Then
        If blnTMP = True Then
            objApp.Quit
            blnTMP = False
        End If
    End If
    Set objApp = Nothing
    If Err.Number <> 0 Then MsgBox "Fehler: " & _
        Err.Number & " " & Err.Description
End Sub
Private Function OffApp(ByVal strApp As String, _
    Optional blnVisible As Boolean = True) As Object
    Dim objApp As Object
    On Error Resume Next
    Set objApp = GetObject(, strApp & ".Application")
    Select Case Err.Number
        Case 429
            Err.Clear
            Set objApp = CreateObject(strApp & ".Application")
            blnTMP = True
            If blnVisible = True Then
                On Error Resume Next
                objApp.Visible = True
                Err.Clear
            End If
    End Select
    On Error GoTo 0
    Set OffApp = objApp
    Set objApp = Nothing
End Function

Code im Modul1 in der Worddatei:

Option Explicit
Sub Test(ByVal lngWert As Long, ByVal strTMP As String)
    MsgBox strTMP & " " & lngWert
End Sub

Beliebte Posts aus diesem Blog

Formeln - auch Array - per VBA eintragen...

Alle Dateien eines Ordners - Optional mit Unterordner

Excel -> Word in Textmarken (Bookmarks)...