Word-Dateien über Excel in eine ausgewählte Word-Datei übert

Forumthread: Word-Dateien über Excel in eine ausgewählte Word-Datei übert

22.08.2024 17:39:55

Rob_bb

Hallo Zusammen,

ich hoffe es kann mir jemand weiterhelfen in dem Forum.

Ich habe ein Makro in der Excel-Datei (Reiter: Datenbank) im Anhang, wo ich mir von allen Word-Dateien den Pfad und den Hyperlink übertragen lasse.
In den Reiter Tabelle1 in der Excel-Datei gibt es in der Spalte D Dropdowns, wo man die jeweilige Datei (Reiter: Datenbank) auswählt, die man benötigt.
Ist es möglich, dass man eine Makro mit folgenden Funktionen schreiben kann:

1. Suchfenster erscheint, um die Word-Datei zu wählen, wo die Texte von den anderen Word-Dateien eingefügt werden sollen.
Habe ich so gemacht:

Sub WordTexteÜbertargenInWorddatei()
Dim AppWD As Object
Dim fn
Const StartDrive = "C:"
Const StartDir = "\"
ChDrive StartDrive
ChDir StartDir
fn = Application.GetOpenFilename("Word-Dokumente, *.docx", , "Bitte Datei auswählen")
If fn = False Then Exit Sub 'Abbrechen gedrückt
Set AppWD = CreateObject("Word.Application") 'Word als Object starten
AppWD.Visible = True
AppWD.documents.Open fn

End Sub

2. Wenn die Word-Datei (z.B. Word-Muster-Empfänger-Datei) gewählt wurde, wo die Texte eingefügt werden sollen (z.B. Word-Muster-1 bis 3), soll das Makro in der Spalte D die Dropdowns auslesen und dann den Texteinhalt der jeweiligen Word-Dateien die im Dropdown Fenster ausgewählt worden sind aus der Datenbank in der reinfolge in Spalte D (von oben nach unten) in die ausgewählte Word-Datei übertragen.

Kann mir da jemand helfen?

Ich habe bereits danach gesucht, jedoch nichts Brauchbares gefunden.

Danke für die Hilfe.

Anhang

https://www.herber.de/bbs/user/171773.zip

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Word-Dateien über Excel in eine ausgewählte Word-Datei übert

23.08.2024 00:50:46

ralf_b

So bitte schön.







Sub TexteInWordUebertragen()

    Dim ws As Worksheet

    Dim wordApp As Object

    Dim wordDoc As Object

    Dim lastRow As Long

    Dim i As Long

    Dim dropdownValue As String

    Dim wordFilePath As String



    ' Arbeitsblatt setzen (aktives Blatt)

    Set ws = ActiveSheet



    ' Letzte Zeile in Spalte D finden

    lastRow = ws.Cells(ws.Rows.Count, "D").End(xlUp).Row



    ' Word-Anwendung erstellen

    Set wordApp = CreateObject("Word.Application")

    wordApp.Visible = True ' Word sichtbar machen



    ' Durch jede Zeile in Spalte D iterieren

    For i = 1 To lastRow

        dropdownValue = ws.Cells(i, "D").Value



        ' Überprüfen, ob ein Dropdown-Wert vorhanden ist

        If dropdownValue > "" Then

            ' Pfad zur Word-Datei festlegen (anpassen)

            wordFilePath = "C:\Pfad\Zu\Deinen\Word\Dateien\" & dropdownValue & ".docx"



            ' Word-Dokument öffnen

            Set wordDoc = wordApp.documents.Open(wordFilePath)



            ' Hier kannst du den Text von der Datenbank oder einer anderen Quelle einfügen

            ' Zum Beispiel:

            ' wordDoc.Content.Text = "Hier steht der Text aus der Datenbank"



            ' Dokument speichern und schließen

            wordDoc.Save

            wordDoc.Close

        End If

    Next i



    ' Word-Anwendung schließen

    wordApp.Quit



    ' Objekte freigeben

    Set wordDoc = Nothing

    Set wordApp = Nothing

End Sub



Sub WordTexteÜbertargenInWorddatei()

    Dim AppWD As Object

    Dim fn As Variant

    Dim wsDatenbank As Worksheet

    Dim wsTabelle1 As Worksheet

    Dim i As Integer, cnt&

    Dim sDateiPfad$, sDateiname$, rngfund As Range

    Dim docZiel As Object, docQuelle As Object

    Dim textInhalt As String



    ' Arbeitsblätter zuweisen

    Set wsDatenbank = ThisWorkbook.Sheets("Datenbank")

    Set wsTabelle1 = ThisWorkbook.Sheets("Tabelle1")



    ' Öffnen des Suchfensters für die Ziel-Word-Datei

    fn = Application.GetOpenFilename("Word-Dokumente, *.docx", , "Bitte Zieldatei auswählen")

    If fn = False Then Exit Sub ' Abbrechen gedrückt



    ' Word-Anwendung starten

    On Error Resume Next

    Set AppWD = GetObject(Class:="Word.Application")

    If AppWD Is Nothing Then

        Set AppWD = CreateObject("Word.Application")

    End If

    On Error GoTo 0

    If AppWD Is Nothing Then MsgBox "Word kann nicht geöffnet werden": Exit Sub

    

    'AppWD.Visible = True

    'Zieldatei öffnen

    Set docZiel = AppWD.documents.Open(fn)



    ' Durchlaufen der Dropdowns in Spalte D der Tabelle1

    For i = 1 To wsTabelle1.Cells(wsTabelle1.Rows.Count, 4).End(xlUp).Row ' Spalte D

        If wsTabelle1.Cells(i, 4).Value > "" Then ' Nur wenn es einen Wert gibt

          sDateiname = wsTabelle1.Cells(i, 4).Value

            

            ' Den dateinamen in der Datenbank suchen

            Set rngfund = Intersect(wsDatenbank.UsedRange, wsDatenbank.Columns(1)).Find(sDateiname, LookIn:=xlValues, lookat:=xlWhole) ' 1 Spalte rechts

            

            If Not rngfund Is Nothing Then

               cnt = cnt + 1

               sDateiPfad = rngfund.Offset(0, 1).Value & "\" & sDateiname

               Set docQuelle = GetObject(sDateiPfad)

               docZiel.Content.InsertAfter vbCr & docQuelle.Content   ' Text mit Zeilenumbruch einfügen

               docQuelle.Close

               Set docQuelle = Nothing

               

            End If

        

        End If

    Next i

     

    ' Word-Dokument speichern

    docZiel.Save

  ' docZiel.Close

    If Not rngfund Is Nothing Then MsgBox "Einfügen von " & cnt & " Blöcken abgeschlossen" Else MsgBox "Nichts zum einfügen ":

   

   'AppWD.Quit

    ' Aufräumen

    Set docZiel = Nothing

    Set AppWD = Nothing

    Set wsDatenbank = Nothing

    Set wsTabelle1 = Nothing

End Sub

Word-Dateien über Excel in eine ausgewählte Word-Datei übert

23.08.2024 09:37:07

Rob_bb

Hallo Rald_b,

das ist echt der Wahnsinn.
Danke das du mir Hilfst.
Nur noch eine Frage:
Ich habe deine zweite Mako in der Excel im Anhang eingefügt und die Texte werden auch in der Ausgewählten Word-Datei super übertragen.
Ist es auch noch möglich, dass die Formatierungen und die Textmarken auch übertragen werden in die Empfänger Word-Datei ?

Danke für deine Hilfe.

Anhang
https://www.herber.de/bbs/user/171779.zip

AW: Word-Dateien über Excel in eine ausgewählte Word-Datei übert

23.08.2024 12:41:53

ralf_b

Ich denke das du hier den Prozess etwas überdenken solltest. Die einzufügenden Bereiche sind doch alle gleich, also warum für jeden eine eigene Datei ?
Es würde ausreichen den Bereich so oft zu verwenden wie benötigt und die Textmarken dann setzen wenn der Bereich eingefügt wird. Damit könnte man die Benennung der Textmarken mach Bedarf steuern. Du hast doch schon neulich mal wegen solcher Geschichten gefragt. Mit dieser Summierung und der "OP" Unterscheidung usw.
Also baust du dir jetzt die Rechnung zusammen. Dafür gibt es aber schon zig Lösungen basierend auf Exceldaten die man in Worddokumente einfügt.
Man sollte das Rad nicht neu erfinden, nur weil man ein anderes Profil haben will.
Ich bin dann hier raus. Word VBA ist nicht meins. Habe ich nur mal probiert mit Hilfe der KI-Implementierung vom Browser und ein bissel googln.

gruß

rb

Word-Dateien über Excel in eine ausgewählte Word-Datei übert

23.08.2024 15:22:00

Rob_bb

Hallo Ralf_b,

ich bin dir trotzdem unglaublich dankbar.
Danke für deine Hilfe.
Ich wünsche dir und deiner Familie ein schönes Wochenende.

Gruß

Rob

Beliebteste Forumthreads (12 Monate)

Word-Dateien über Excel in eine ausgewählte Word-Datei übert

Forumthread: Word-Dateien über Excel in eine ausgewählte Word-Datei übert

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Word-Dateien über Excel in eine ausgewählte Word-Datei übert

Forumthread: Word-Dateien über Excel in eine ausgewählte Word-Datei übert

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread