Herbers Excel/VBA-Archiv

Informationen und Beispiele zum Thema MsgBox
Screenshot zu MsgBox	MsgBox-Seite mit Beispielarbeitsmappe aufrufen

Informationen und Beispiele zum Thema TextBox
Screenshot zu TextBox	TextBox-Seite mit Beispielarbeitsmappe aufrufen

Daten von Excel nach Word kopieren

• Daten von Excel nach Word kopieren von Hedwig vom 28.07.2014 12:12:50
• AW: Daten von Excel nach Word kopieren - von Hajo_Zi am 28.07.2014 12:45:19
• AW: Daten von Excel nach Word kopieren - von fcs am 28.07.2014 13:24:04
• AW: Daten von Excel nach Word kopieren - von Dieter Klemke am 28.07.2014 13:24:30
  • AW: Daten von Excel nach Word kopieren - von Hedwig am 28.07.2014 13:58:16
    • AW: Daten von Excel nach Word kopieren - von Dieter Klemke am 28.07.2014 14:54:21

Betrifft: Daten von Excel nach Word kopieren von: Hedwig
Geschrieben am: 28.07.2014 12:12:50

Hallo,

als blutiger VBA-Anfänger habe ich mir ein viel zu hohes Ziel gesetzt und verzweifle, vielleicht gibt es ja da draußen eine gute Seele, die einen heißen Tip für mich hat?

Mein Plan:

Ich habe ein Auftragsbuch in Excel angelegt und möchte per Klick auf einen Button eine Rechnung in Word erstellen lassen.
Word müsste also an bestimmten Stellen (diese habe ich mit Bookmarks markiert) bestimmte Informationen aus Excel übernehmen, z.B. Rechnungsdatum, Kunde, Preis etc.
Und um das Ganze noch ein bisschen interessanter zu gestalten, soll Excel auch noch wissen, dass es bitte schön die Daten des zuvor ausgewählten Auftrags übernimmt.

Den Button zu erstellen und dafür zu sorgen, dass dieser mir auch brav die erstellte Schablone öffnet, war kein Problem. Ich bin auch noch so weit gekommen, dass automatisch die letzte aktive Zelle ausgewählt wird, aber dann hört's auf.

Makro:

Sub FindLast1()
    ActiveCell.SpecialCells(xlLastCell).Select
End Sub

Sub WordDateiStarten()

      CreateObject("Word.application").Documents.Open("c:\Users\laptop\Desktop\MHG Translations\ _
Rechnungen\Rechnung.docx").Application.Visible = True
        End Sub

Bitte nicht falsch verstehen:
Ich erwarte nicht, dass mir hier jemand ein fertiges Makro liefert, viel mehr erhoffe ich mir einen Denkansatz oder auch einfach ein klares: "Mädel, das wird noch nichts, beschäftige dich erst mal 'ne Weile mit VBA!" :-)

Ich bin für jeden Tip dankbar.

Liebe Grüße,
Hedwig

Betrifft: AW: Daten von Excel nach Word kopieren von: Hajo_Zi
Geschrieben am: 28.07.2014 12:45:19

Halo Hedwig,

Du kennst Dich ja mit VBA aus. Word ich nicht so mein Gebiet. Ich habe mal so was ähnliches in Word realisiert mit einer UserForm. Die TextBoxen hatten den gleichen Namen wie die Textmarke.
Vielleicht ist dies ein Ansatz.

Private Sub CmMD_Ende_Click()
    TXT_Datum = Format(Date, "dd.MM.yyyy")
    TXT_Anrede = CBO_Anrede.Value
'   TXT_Anrede2 im Briefkopf
    Select Case TXT_Anrede
        Case "Herr"
            TXT_Anrede2 = "r " & TXT_Anrede
        Case "Frau"
            TXT_Anrede2 = " " & TXT_Anrede
        Case "Damen und Herren"
            TXT_Anrede2 = " " & TXT_Anrede
    End Select
    If CBO_Verkauf = "Rüdiger Doll" Or CBO_Verkauf = "Thomas Dix" Then
        StFunktion = "Vertriebsleiter"
    ElseIf CBO_Projektierung = "Matthias Bergatt" Then
        StFunktion = "Projektierungsingenieur"
    Else
        StFunktion = "Gebietsverkaufsleiter"
    End If
    StEigenschaft = TXT_Firma1
    TXT_Verkauf = CBO_Verkauf.Value
    TXT_Projektierung = CBO_Projektierung
    If TXT_Firma1 = "" Then
        TXT_Firma1 = "Firma1"
        TXT_Firma2 = "Firma2"
'        TXT_Anrede2 = "Herr"
'        TXT_Anrede = "r " & TXT_Anrede
        TXT_Nachname = "Mustermann"
        TXT_Straße = "Straße"
        TXT_Ort = "00000 Ort"
        TXT_Angebot = StJahr & "-30xxx"
        TXT_Version = "x"
    End If
    StDateiname = TXT_Angebot & "AN" & TXT_Version
'   zuordnen der Textfelder
    Dim TMRange As Range
    Dim X
''      zum Löschen des Inhaltes von den TXT-Boxen,
''       um Textmarken in den Textbausteinen zu löschen
''      userform einzeln starten!!!
'     For Each X In Me.Controls
'      If TypeOf X Is MSForms.TextBox Then
''        TMName = x.Name
''        MsgBox X.Name
'        X.Value = ""
'      End If
'    Next
'   Textmarken ins Dokument schreiben
     For Each X In Me.Controls
      If TypeOf X Is MSForms.TextBox Then
'        TMName = x.Name
'        MsgBox X.Name
        If ActiveDocument.Bookmarks.Exists(X.Name) Then
          Set TMRange = ActiveDocument.Bookmarks(X.Name).Range
          TMRange.Text = X.Text
          ActiveDocument.Bookmarks.Add Name:=X.Name, Range:=TMRange
        End If
      End If
    Next
''    zum Löschen des Inhaltes von den TXT-Boxen,
''    um Textmarken in den Textbausteinen zu löschen
'    end
    
'   aktualisierung
    Selection.WholeStory
    Selection.Fields.Update
    Selection.HomeKey unit:=wdStory
    StKunde1 = TXT_Firma1
    StAngebotsnummer = TXT_Angebot
    If InStr(TXT_Ort, " ") <> 0 Then
        StOrt = Mid(TXT_Ort, InStr(TXT_Ort, " ") + 1, Len(TXT_Ort))
    Else
        StOrt = TXT_Ort
    End If
    
'   peppi MS-Office Forum  FelderAktualisieren()
    Application.ScreenUpdating = False
    ActiveDocument.Repaginate
    Dim RaTeil As Range
    For Each RaTeil In ActiveDocument.StoryRanges
        RaTeil.Fields.Update
        While Not (RaTeil.NextStoryRange Is Nothing)
            Set RaTeil = RaTeil.NextStoryRange
            RaTeil.Fields.Update
        Wend
    Next
    Application.ScreenUpdating = True
    Set TMRange = Nothing
    Set RaTeil = Nothing
    Unload FRM_Kundendaten
    If StVariante = "Kurz" Or BoKurzkurz Or BoMail Then FRM_Ausruestung.Show
End Sub

Betrifft: AW: Daten von Excel nach Word kopieren von: fcs
Geschrieben am: 28.07.2014 13:24:04

Hallo Hedwig,

für einen VBA-Anfänger ist dein Vorhaben schon etwas ambitioniert.
Aber irgendwo muss man ja anfangen.
Wichtig ist das Arbeiten mit entsprechenden Variablen, um sich hier das Leben zu erleichtern und den Überblick nicht zu verlieren.

Ich hab deine Ansätze mal ein wenig erweitert/angepasst inkl. Beispielen wie die Excel-Zellinhalte an den Textmarken eingefügt werden können.

Gruß
Franz

Sub Auftrag_Excel_nach_Word()
  Dim strFileName As String
  Dim objWDApp As Object  'Word.Application
  Dim objDoc As Object    'Word.Document
  Dim xlZelle As Range    'Referenzzelle in Excel
  
  strFileName = "c:\Users\laptop\Desktop\MHG Translations\Rechnungen\Rechnung.docx"""
  
  If Dir(strFileName) = "" Then
    MsgBox "Datei """ & strFileName & """ nicht gefunden!"
    Exit Sub
  End If
  
  'Excel-Referenzzelle für Auftrag setzen
  ActiveCell.SpecialCells(xlLastCell).Select
  With ActiveSheet
    Set xlZelle = .Cells(ActiveCell.Row, 1) ' Zelle in aktiver Zeile, Spalte A
  End With
  
  Application.ScreenUpdating = False
  
  'Word-Anwendung sichtbar starten
  Set objWDApp = CreateObject("Word.Application")
  objWDApp.Visible = True
  'Vorlage öffnen - schreibgeschützt
  Set objDoc = objWDApp.Documents.Open(strFileName, ReadOnly:=True)
  
  'Werte aus Zellen in Excel an Textmarken im Worddokument einfügen
  objDoc.Bookmarks("Kundennummer").Range.Text = xlZelle.Text       'aus Spalte A
  objDoc.Bookmarks("Rechnungsdatum").Range.Text = xlZelle.Offset(0, 1).Text 'aus Spalte B
  objDoc.Bookmarks("Preis").Range.Text = xlZelle.Offset(0, 2).Text 'aus Spalte C
  
  Application.ScreenUpdating = True
End Sub

Betrifft: AW: Daten von Excel nach Word kopieren von: Dieter Klemke
Geschrieben am: 28.07.2014 13:24:30

Hallo Hedwig,
ich habe ein Beispiel in meiner Sammlung, welches ein paar Ähnlichkeiten aufweist.
Zu jeder Zeile in der Excel-Tabelle wird ein Word-Dokument nach einer Vorlage erstellt.
Das Programm sieht folgendermaßen aus:

Sub Mitteilungen_erstellen()
  Dim abt As String
  Dim DatEigensch As Boolean
  Dim dok As Word.Document
  Dim letzteZeile As Long
  Dim pfad As String
  Dim punkte As String
  Dim wdApp As Word.Application
  Dim ws As Worksheet
  Dim zeile As Long
  
  pfad = ThisWorkbook.Path & "\"
  ' Word unsichtbar starten
  Set wdApp = New Word.Application
  ' Word sichtbar machen (falls gewünscht, sonst auskommentieren)
  wdApp.Visible = True
  ' Abfrage nach Datei-Eigenschaften zw.speichern
  ' und anschließend ausschalten
  DatEigensch = wdApp.Options.SavePropertiesPrompt
  wdApp.Options.SavePropertiesPrompt = False
  ' Ein neues Dokument anlegen und unter dem
  ' Namen "FehlerListe.doc" wegspeichern
  Set dok = wdApp.Documents.Add
  ' Abfrage zur Eingabe der Dateieigenschaften
  ' zwischenspeichern und ausschalten
  DatEigensch = wdApp.Options.SavePropertiesPrompt
  wdApp.Options.SavePropertiesPrompt = False
  ' ws - Tabellenblatt mit den Wettbewerbsergebnissen
  Set ws = ThisWorkbook.Worksheets("Ergebnis")
  letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  If letzteZeile < 2 Then Exit Sub
  ' Ergebnistabelle abarbeiten
  For zeile = 2 To letzteZeile
    abt = ws.Cells(zeile, "A")
    punkte = ws.Cells(zeile, "B")
    ' Mitteilungsschreiben für die lfd. Abt.
    ' erzeugen
    wdApp.Documents.Add Template:=pfad & "Wettbewerb.dot"
    wdApp.ActiveDocument.Bookmarks("Abteilung").Range.Text = abt
    wdApp.ActiveDocument.Bookmarks("Punkte").Range.Text = punkte
    ' Dateieigenschaft setzen
    wdApp.ActiveDocument.BuiltinDocumentProperties("Title") = "Erg. Service-Wettbewerb " & abt
    wdApp.ActiveDocument.SaveAs Filename:=pfad & "Wettbewerb" & abt & ".doc"
    wdApp.ActiveDocument.Close
  Next zeile
  ' Abfrage zur Eingabe von Dateieigenschaften
  ' zurücksetzen
  wdApp.Options.SavePropertiesPrompt = DatEigensch
  ' Word schließen
  wdApp.Quit
End Sub

Ich lade dir die Wordvorlage (gezippt, da Herber keine dot-Dateien mag) und die Arbeitsmappe hoch.
https://www.herber.de/bbs/user/91754.zip
https://www.herber.de/bbs/user/91755.xls

MfG
Dieter

Betrifft: AW: Daten von Excel nach Word kopieren von: Hedwig
Geschrieben am: 28.07.2014 13:58:16

Wahnsinn!

Vielen Dank! Ihr seid toll!
Da werde ich mich doch gleich mal ans Basteln machen - mit so tollen Vorlagen kann es ja eigentlich nur gut gehen!

DANKE

Betrifft: AW: Daten von Excel nach Word kopieren von: Dieter Klemke
Geschrieben am: 28.07.2014 14:54:21

Hallo Hedwig,
ich habe gerade gesehen, dass da noch etwas überflüssiges Zeugs hängen geblieben ist.
Hier die etwas entschlackte Version:

Sub Mitteilungen_erstellen()
  Dim abt As String
  Dim DatEigensch As Boolean
  Dim dok As Word.Document
  Dim letzteZeile As Long
  Dim pfad As String
  Dim punkte As String
  Dim wdApp As Word.Application
  Dim ws As Worksheet
  Dim zeile As Long
  
  pfad = ThisWorkbook.Path & "\"
  ' Word unsichtbar starten
  Set wdApp = New Word.Application
  ' Word sichtbar machen (falls gewünscht, sonst auskommentieren)
  wdApp.Visible = True
  ' Abfrage nach Datei-Eigenschaften zw.speichern
  ' und anschließend ausschalten
  DatEigensch = wdApp.Options.SavePropertiesPrompt
  wdApp.Options.SavePropertiesPrompt = False
  Set ws = ThisWorkbook.Worksheets("Ergebnis")
  letzteZeile = ws.Cells(ws.Rows.Count, "A").End(xlUp).Row
  If letzteZeile < 2 Then Exit Sub
  ' Ergebnistabelle abarbeiten
  For zeile = 2 To letzteZeile
    abt = ws.Cells(zeile, "A")
    punkte = ws.Cells(zeile, "B")
    ' Mitteilungsschreiben für die lfd. Abt.
    ' erzeugen
    Set dok = wdApp.Documents.Add(Template:=pfad & "Wettbewerb.dot")
    dok.Bookmarks("Abteilung").Range.Text = abt
    dok.Bookmarks("Punkte").Range.Text = punkte
    ' Dateieigenschaft setzen
    dok.BuiltinDocumentProperties("Title") = "Erg. Service-Wettbewerb " & abt
    dok.SaveAs Filename:=pfad & "Wettbewerb" & abt & ".doc"
    dok.Close
  Next zeile
  ' Abfrage zur Eingabe von Dateieigenschaften
  ' zurücksetzen
  wdApp.Options.SavePropertiesPrompt = DatEigensch
  ' Word schließen
  wdApp.Quit
End Sub

Viele Grüße
Dieter

Beiträge aus den Excel-Beispielen zum Thema "Daten von Excel nach Word kopieren"