Exceltabelle daten per combobox zu word Datei
19.04.2024 15:39:42
Ritchi788
Option Explicit
Private Sub Suchfeld_Click()
'einige Variablen und Objekte definiern
Dim Az As String 'Aktenzeichen
Dim zeNr As Long 'Zeilennummer
Dim ws As Worksheet 'die Excel-Tabelle mit den Daten
' Word-Application wird aktiviert 'Late Binding'
' daher ist kein Verweis mehr erforderlich
Dim wdApp As Object
Dim wdDoc As Object
' den Ablauf verzögernde Events abschalten
Application.ScreenUpdating = False
Application.EnableEvents = False
' Aktenzeichen und die entsprechende Zeilennummer anhand der
' angeklickten Zeile in der DropDown-Liste in die Variablen 'Az' und 'zeNr' schreiben
Az = Me.Suchfeld.List(Me.Suchfeld.ListIndex)
zeNr = Me.Suchfeld.ListIndex+2
' die Auswahl im Dropdown ist jetzt nicht mehr erforderlich, also aufheben
Me.Suchfeld.ListIndex = -1
' Word starten
Set wdApp = CreateObject("Word.Application")
' und sichtbar machen
wdApp.Visible = True
' das Word-Dokument ööfnen
' Set wdDoc = wdApp.Documents.Open("C:\Temp\test.docx")
' die Excel-Tabelle 'Tabelle1' wird zum Objekt 'ws' erhoben
Set ws = ThisWorkbook.Sheets(1)
' Daten aus dem Objet 'ws' in das Word-Dokument einfügen
With wdDoc
.Bookmarks("Aktenzeichen").Range.Text = ws.Cells(zeNr, 1)
.Bookmarks("Datum").Range.Text = Format(ws.Cells(zeNr, 3), "DD.MM.YYYY")
.Bookmarks("Uhrzeit").Range.Text = Format(ws.Cells(zeNr, 4), "hh:mm")
.Bookmarks("Ort").Range.Text = ws.Cells(zeNr, 5)
.Bookmarks("Vorname").Range.Text = ws.Cells(zeNr, 7)
.Bookmarks("Name").Range.Text = ws.Cells(zeNr, 8)
.Bookmarks("Geburtsdatum").Range.Text = Format(ws.Cells(zeNr, 9), "DD.MM.YYYY")
.Bookmarks("Adresse").Range.Text = ws.Cells(zeNr, 10)
.Bookmarks("Postleitzahl").Range.Text = ws.Cells(zeNr, 11)
.Bookmarks("Stadt").Range.Text = ws.Cells(zeNr, 12)
.Bookmarks("Konsummittel").Range.Text = ws.Cells(zeNr, 13)
' Hier weitere Datenfelder entsprechend der Spalten in Excel einfügen
End With
' Word in den Vordergund holen
wdApp.Activate
' die mit 'Set" definierten Objekte aus dem Speicher löschen
Set wdDoc = Nothing
Set wdApp = Nothing
' die für den normalen Ablauf deaktivierten Events wieder aktivieren
Application.ScreenUpdating = True
Application.EnableEvents = True
End Sub
Anzeige