AW: Variablen von Word nach Excel übergeben
14.05.2008 08:17:00
Word
Hallo Stefan,
die Variablen können nicht von einem Word- an ein Excelmaro übergeben werden.
Du kannst aber von Excel aus per VBA Informationen aus dem Worddokument auslesen oder auch von Word aus die Erforderlichen Änderungen per VBA im Exceldokument machen.
Die Konstante Pfad in den Makros muss du ggf. anpassen.
Gruß
Franz
Variante 1, Word startet das Excelmakro
'Wordmakro:
'im Word VBA-Editor muss der Verweis auf die Excel-Object Library aktiviert sein!
'Erstellt unter Word 97/ Excel 97
Sub TextmarkenNachExcel()
'Textmarkeninhalte in Excelblatt eintragen (mit Excel-Makro)
Dim objWbLiefer As Excel.Workbook, objwksLiefer As Excel.Worksheet
Dim strMakro As String
Dim objDoc As Word.Document
Const strPfad As String = "C:\Test"
Const strExceldatei As String = "Lieferscheinnummer.xls"
Const strExcelBlatt As String = "Liefer"
Set objDoc = ActiveDocument
'Exceldatei öffnen
Set objWbLiefer = Excel.Workbooks.Open(FileName:=strPfad & _
Application.PathSeparator & strExceldatei)
If objWbLiefer.ReadOnly = True Then
MsgBox "Die Datei " & strExceldatei & " ist von anderem Anwender geöffnet!" & vbLf _
& "Makro wird abgebrochen", vbOKOnly, "Textmarken nach " & strExceldatei
objWbLiefer.Close
Excel.Application.Quit
GoTo Beenden
End If
Application.WindowState = wdWindowStateMinimize
Excel.Application.Visible = True
Set objwksLiefer = objWbLiefer.Worksheets(strExcelBlatt)
'Makro in Excel starten, das auszufüllende Zelle selektiert und Daten übernimmt
strMakro = "LetzteZeile"
Excel.Application.Run objWbLiefer.Name & "!" & objwksLiefer.CodeName & "." & strMakro
'Exceldatei speichern und schließen
'objWbLiefer.Save
'Excel.Application.Quit
Beenden:
Set objWbLiefer = Nothing: Set objwksLiefer = Nothing: Set objZelle = Nothing
Set objDoc = Nothing
End Sub
'Excelmakros im Tabellenblatt:
'im Excel-VBA-Editor den Verweis auf die Miceosoft Word Objekt Library aktivieren!
'Erstellt unter Word 97/ Excel 97
Sub LetzteZeile()
MsgBox "Hallo Letzte Zeile"
Dim objWks As Worksheet
Set objWks = ThisWorkbook.Worksheets("Liefer")
With objWks
.Cells(.Rows.Count, 1).End(xlUp).Offset(1, 0).Select
End With
Call Textmarkenholen(ActiveCell)
End Sub
Sub Textmarkenholen(objZelle As Range)
Dim wdDok As Word.Document
Set wdDok = Word.Application.ActiveDocument
With objZelle
.Value = wdDok.Bookmarks("Textmarke01").Range.Text
.Offset(0, 1).Value = wdDok.Bookmarks("Textmarke02").Range.Text
End With
End Sub
'Variante 2:Alle erforderlichen Einträge im Excelblatt werden von Word aus gemacht
Sub TextmarkenNachExcel_Variante()
'Textmarkeninhalte in Excelblatt eintragen (ohne Excel-Makro)
Dim objWbLiefer As Excel.Workbook, objwksLiefer As Excel.Worksheet
Dim objZelle As Excel.Range
Dim objDoc As Word.Document
Const strPfad As String = "C:\Test"
Const strExceldatei As String = "Lieferscheinnummer.xls"
Const strExcelBlatt As String = "Liefer"
Set objDoc = ActiveDocument
'Exceldatei öffnen
Set objWbLiefer = Excel.Workbooks.Open(FileName:=strPfad & _
Application.PathSeparator & strExceldatei)
'Prüfen, ob Datei schreibgeschützt geöffnet wurde
If objWbLiefer.ReadOnly = True Then
MsgBox "Die Datei " & strExceldatei & " ist von anderem Anwender geöffnet!" & vbLf _
& "Makro wird abgebrochen", vbOKOnly, "Textmarken nach " & strExceldatei
objWbLiefer.Close
Excel.Application.Quit
GoTo Beenden
End If
Application.WindowState = wdWindowStateMinimize
Excel.Application.Visible = True
Set objwksLiefer = objWbLiefer.Worksheets(strExcelBlatt)
'auszufüllende Zelle im Blatt Liefer suchen (nächste frei Zelle in Spalte A)
Set objZelle = objwksLiefer.Cells(LetzteZeile(objwksLiefer, 1), 1).Offset(1, 0)
'Zeile mit Textmarken-Inhalten auffüllen
With objZelle
.Value = objDoc.Bookmarks("Textmarke01").Range.Text
.Offset(0, 1).Value = objDoc.Bookmarks("Textmarke02").Range.Text
End With
Beenden:
Set objWbLiefer = Nothing: Set objwksLiefer = Nothing: Set objZelle = Nothing
Set objDoc = Nothing
End Sub
Function LetzteZeile(objWks As Excel.Worksheet, lngSpalte As Long) As Long
'Letzte Zelle mit Daten in Spalte der Tabelle
With objWks
If IsEmpty(.Cells(.Rows.Count, lngSpalte)) Then
LetzteZeile = .Cells(.Rows.Count, lngSpalte).End(xlUp).Row
Else
LetzteZeile = .Rows.Count
End If
End With
End Function