Dateien in Word zusammenfügen

Dieses Thema Dateien in Word zusammenfügen im Forum "Microsoft Office Suite" wurde erstellt von Neuhier, 23. Okt. 2005.

Thema: Dateien in Word zusammenfügen Hallo zusammen, ich möchte in Word 2002 mehrere .doc Dateien so zusammenfügen, daß in der neuen Datei sämtliche...

  1. Hallo zusammen,

    ich möchte in Word 2002 mehrere .doc Dateien so zusammenfügen, daß in der neuen Datei sämtliche Formatierungen, also auch die Seitenformatierungen der alten Dateien automatisch erhalten bleiben.

    Über Einfügen>Datei wird leider die Seitenformatierung aus der einzufügenden Datei nicht übernommen bzw. ich kann keine Option dafür finden.


    Grüße
     
  2. Wenn die verschiedenen Dokumente verschiedene Seitenformatierungen haben, weiß Word nicht was es machen soll.
    Probier mal Einfügen\manueller Umbruch.
     
  3. Hallo Dine,

    ich fasse praktisch jeden Tag mehrere Dateien zu einem .doc Dokument zusammen. Wenn ich vorher das einzufügende Dokument mit der Hand bearbeite und 2 Umbrüche einfüge, klappt es jetzt auch ganz gut.

    Das ist nur jedesmal sehr umständlich. Gibt es da nicht eine Möglichkeit, das zu automatisieren?

    Grüße
     
  4. Probiers mal mit einem Makro. Notfalls einfach Makros aufzeichnen - kenn mich in VBA nicht gut genug aus, um dir den entsprechenden Code liefern zu können.
     
  5. Ein Makro ist eine gute Lösung. Ich bin da allerdings noch Anfänger.

    Das Makro müßte auch gleich 2 Dokumente bearbeiten. Gibt es da vielleicht eine Beschreibung. Ich habe schon vergeblich gesucht.

    Grüße
     
  6. Hallo Neuhier,

    wie soll den der Makro arbeiten? Woher soll er die Documente nehmen ? Woher kann das Makro die  Reihenfolge der Dokumente entnehmen ? Soll ein neues Dokument angelegt werden und in diesem dann die Dokumente eingefügt werden ?

    Zusammengefaßt: Welche Logik soll das Makro abfahren ?

    Gruß Matjes :)
     
  7. Hallo Matjes,

    da jeweils mehrere Dateien zusammengefasst werden sollen, wäre es wohl am besten von der Zieldatei aus zu arbeiten.

    Die manuellen Umbrüche sollten aber in den Ursprungsdateien eingefügt werden, sonst klappt die Formatübernahme nicht.

    Die Dateien werden jedesmal einzeln bestimmt, d.h. es ist eine wechselnde Dateiliste, die jeweils zusammengefaßt wird.

    Die Dateien selber sind alle auf einem Laufwerk, meistens in einem Ordner.

    Die Funktion sollte so sein, daß ich entweder die Ursprungsdatei jeweils an die Zieldatei anhänge oder in der Zieldatei einzelne Dateien einfüge. Dabei sollten dann alle Formatierungen erhalten bleiben.


    Grüße
     
  8. Hallo Neuhier,

    ich werd mal einen Makro zusammenstellen. Kann noch etwas dauern ...

    Gruß Matjes :)
     
  9. Hallo Neuhier,

    hab dir etwas zusammengebaut  ;)

    Lege ein neues Word-Dokument an z.B. mit dem Namen Makro_DocsZusammenfassen. Mit dem VB-Editor legst Du in diesem Dokument ein Modul an und kopierst den Makro in das Modul-Fenster.

    Das Dokument legst Du dann in einen Unterordner mit dem Namen 99_Makro.
    Parallel zu dem Unterordner sollten die Unterordner 01_Input und 02_Output liegen. Im  Unterverzeichnis 01_Input noch ein Verzeichnis Sava.

    In das Verzeichnis 01_Input kopierst Du deine zusammenzufassenden docs.
    Dann öffnest du das Document in 99_Makro und startest den Makro Word_DocsZusammenfassen.

    Probier's mal aus, ob es das trifft, was du wolltest.

    Gruß Matjes :)

    Code:
    Option Explicit
    '*********************************************************
    Sub Word_DocsZusammenfassen()
    '***
    '*** Arbeitsumgebung:
    '*** beliebiges Verziechnis mit den Unterverzeichnissen
    '*** 99_Makro         - Ablageort dieses Makros
    '*** 01_Input         - Verzeichnis zur Aufnahme  der zusammenzufassenden Dokumente
    '*** 01_Input\Save    - Verzeichnis zur Sicherung der zusammenzufassenden Dokumente
    '*** 02_Output        - Verzeichnis des               zusammengefassten   Dokumentes
    '***
    '*** Es ist zunächst ein Dokument aus dem Input-Verzeichnis als Zieldokument auszuwählen.
    '*** Danach werden die restlichen Dokumente aus dem Input-Verzeichnis an diese Dokument
    '*** angehängt, durch einen manuellen Abschnittswechsel getrennt.
    '*** Das zusammengefaßte Dokument ist in 02Output unter dem Namen des Zieldokumentes zu finden.
    '*** Alle Input-Files werden in 01Input\Save gesichert.
    
    
      Dim s_doc_ziel As String, s_doc_tmp As String
      Dim zdoc As Document, tdoc As Document
      
     ->Pfade
      Dim s_PfadInput  As String, s_PfadInputSave  As String, s_PfadOutput  As String
    
      Application.ScreenUpdating = False
    
     ->Zieldatei bestimmen, sichern und ins Output-Verzeichnis verschieben
      If Not Word_PfadeBestimmen(s_PfadInput, s_PfadInputSave, s_PfadOutput) Then GoTo AUFRAEUMEN
      If Not ZieldateiBestimmen(s_PfadInput, s_doc_ziel) Then GoTo AUFRAEUMEN
      If Not DateiSichern(s_PfadInput, s_PfadInputSave, s_doc_ziel) Then GoTo AUFRAEUMEN
      If Not DateiInOutputKopieren(s_PfadInput, s_PfadOutput, s_doc_ziel) Then GoTo AUFRAEUMEN
      If Not DateiLoeschen(s_PfadInput, s_doc_ziel) Then GoTo AUFRAEUMEN
      
     ->Zieldatei öffnen
      If Not DateiOeffnen(s_PfadOutput, s_doc_ziel, zdoc) Then GoTo AUFRAEUMEN
      
     ->alle verbliebenen Dokumente im Input-Verzeichnis anfügen
      Do
       ->Nächste anzuhängende Datei bestimmen und sichern
        If Not NaechsteDateiBestimmen(s_PfadInput, s_doc_tmp) Then GoTo AUFRAEUMEN
        If s_doc_tmp =  Then Exit Do
        If Not DateiSichern(s_PfadInput, s_PfadInputSave, s_doc_tmp) Then GoTo AUFRAEUMEN
        
        
       ->Abschnittswechsel in Zieldatei anhängen
        zdoc.Activate
        Selection.WholeStory
        Selection.Collapse Direction:=wdCollapseEnd
        Selection.InsertBreak Type:=wdSectionBreakNextPage
    
       ->Nächste anzuhängende Datei öffnen
        If Not DateiOeffnen(s_PfadInput, s_doc_tmp, tdoc) Then GoTo AUFRAEUMEN
        
       ->Nächste anzuhängende Datei alles kopieren
        Selection.WholeStory
        Selection.Copy
        
       ->in Zieldatei anfügen
        zdoc.Activate
        Selection.Paste
    
       ->Nächste anzuhängende Datei schliessen ohne Speichern und im Input löschen
        If Not DateiSchliessen(tdoc, True) Then GoTo AUFRAEUMEN
        If Not DateiLoeschen(s_PfadInput, s_doc_tmp) Then GoTo AUFRAEUMEN
      
      Loop
      
     ->Zieldatei schliessen mit Speichern
      If Not DateiSchliessen(zdoc, True) Then GoTo AUFRAEUMEN
      
      Application.ScreenUpdating = True
      
    AUFRAEUMEN:
      Set zdoc = Nothing: Set tdoc = Nothing
    End Sub
    '*******************************************************************************
    Private Function NaechsteDateiBestimmen(s_PfadInput As String, _
                                            s_doc As String) As Boolean
      Dim f() As String, f_cnt As Long
      
      NaechsteDateiBestimmen = False
      s_doc = 
      
      Call DateienImVerzeichnisSuchen(s_PfadInput, *.doc, f(), f_cnt)
      
      If f_cnt = 0 Then NaechsteDateiBestimmen = True: Exit Function
      
      s_doc = DateiAuswaehlen(Auswahl Zieldatei, f(), f_cnt)
      
      If s_doc =  Then
        MsgBox (Auswahl Zieldatei wurd abgebrochen)
        Exit Function
      End If
      
      NaechsteDateiBestimmen = True
    End Function
    '*******************************************************************************
    Private Function DateiSchliessen(doc As Document, b_Savechanges As Boolean) As Boolean
      
      DateiSchliessen = False
      
      On Error Resume Next
      doc.Close Savechanges:=b_Savechanges
      If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox (File konnte nicht gegeschlossen werden. & vbLf & doc.Name)
        Exit Function
      End If
      On Error GoTo 0
      
      DateiSchliessen = True
    End Function
    '*******************************************************************************
    Private Function DateiOeffnen(s_Pfad As String, _
                                  s_doc As String, _
                                  doc As Document) As Boolean
      
      DateiOeffnen = False
      
      On Error Resume Next
      Set doc = Documents.Open(FileName:=s_Pfad & \ & s_doc)
      If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox (File konnte nicht geöffnet werden. & vbLf & s_Pfad & \ & s_doc)
          Exit Function
      End If
      On Error GoTo 0
      
      DateiOeffnen = True
    End Function
    
    '*******************************************************************************
    Private Function DateiLoeschen(s_Pfad As String, _
                                   s_doc As String) As Boolean
      
      DateiLoeschen = False
      
      On Error Resume Next
      Kill s_Pfad & \ & s_doc
      If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox (File konnte nicht gelöscht werden. & vbLf & s_Pfad & \ & s_doc)
          Exit Function
      End If
      On Error GoTo 0
      
      DateiLoeschen = True
    End Function
    '*******************************************************************************
    Private Function DateiInOutputKopieren(s_Pfad As String, _
                                           s_PfadSave As String, _
                                           s_doc As String) As Boolean
      Dim ret As Integer
      
      DateiInOutputKopieren = False
      
     ->prüfen, ob Datei bereits vorhanden ist
      If Dir(s_PfadSave & \ & s_doc, vbNormal) <>  Then
       ->bereits vorhanden, Nachfrage auf überschreiben
        ret = MsgBox( _
                Datei-> & s_PfadSave & \ & s_doc &-> bereits vorhanden. & vbLf & vbLf & _
                Soll die Datei überschrieben werden?, _
                vbQuestion + vbDefaultButton2 + vbYesNo)
        If ret = vbNo Then Exit Function
      End If
      
      If Not DateiSichern(s_Pfad, s_PfadSave, s_doc) Then Exit Function
      DateiInOutputKopieren = True
    End Function
    '*******************************************************************************
    Private Function DateiSichern(s_Pfad As String, _
                                  s_PfadSave As String, _
                                  s_doc As String) As Boolean
      
      DateiSichern = False
      On Error Resume Next
      FileCopy _
        s_Pfad & \ & s_doc, _
        s_PfadSave & \ & s_doc
      If Err.Number <> 0 Then
        Err.Clear: On Error GoTo 0
        MsgBox (File konnte nicht gesichert werden. & vbLf & s_Pfad & \ & s_doc)
          Exit Function
      End If
      On Error GoTo 0
      DateiSichern = True
    End Function
    '*******************************************************************************
    Private Function ZieldateiBestimmen(s_PfadInput As String, _
                                        s_doc_ziel As String) As Boolean
      Dim f() As String, f_cnt As Long
      
      ZieldateiBestimmen = False
      s_doc_ziel = 
      
      Call DateienImVerzeichnisSuchen(s_PfadInput, *.doc, f(), f_cnt)
      
      If f_cnt = 0 Then
        MsgBox (Keine Documente im Input-Verzeichnis)
        Exit Function
      End If
      
      s_doc_ziel = DateiAuswaehlen(Auswahl Zieldatei, f(), f_cnt)
      
      If s_doc_ziel =  Then
        MsgBox (Auswahl Zieldatei wurd abgebrochen)
        Exit Function
      End If
      
      
      ZieldateiBestimmen = True
    End Function
    '*******************************************************************************
    Private Function DateienImVerzeichnisSuchen(s_Pfad As String, _
                                                s_filename As String, _
                                                f() As String, f_cnt As Long)
      Dim i As Long
      
      f_cnt = 0: ReDim f(1 To 1)
      
      With Application.FileSearch
        .NewSearch
        .LookIn = s_Pfad
        .SearchSubFolders = False
        .FileName = s_filename
        If .Execute() > 0 Then
    
          For i = 1 To .FoundFiles.Count
           ->Filenamen in Feld
            f_cnt = f_cnt + 1: ReDim Preserve f(1 To f_cnt)
            f(f_cnt) = Right(.FoundFiles(i), Len(.FoundFiles(i)) - Len(s_Pfad) - 1)
          Next i
        End If
      End With
    
    End Function
    
    '*******************************************************************************
    Private Function Word_PfadeBestimmen(s_PfadInput As String, _
                                         s_PfadInputSave As String, _
                                         s_PfadOutput As String) As Boolean
      
      Const c_TeilPfad_Makro = 99_Makro
      Const c_TeilPfad_Input = 01_Input
      Const c_TeilPfad_InputSave = 01_Input\Save
      Const c_TeilPfad_Output = 02_Output
      
      Dim s_Pfad As String, ret As Integer
      
      Word_PfadeBestimmen = False
      
     ->Makro-Pafd bestimmen
      s_Pfad = ThisDocument.Path
    
      If Right(s_Pfad, Len(c_TeilPfad_Makro)) <> c_TeilPfad_Makro Then
        MsgBox ( _
          Makro erwartet Aufrufverzeichnis ...\ & c_TeilPfad_Makro & vbCrLf & _
          Aufgerufen aus :  & s_Pfad)
          Exit Function
      End If
      
      s_Pfad = Left(s_Pfad, Len(s_Pfad) - Len(c_TeilPfad_Makro))
      
      s_PfadInput = Word_PfadPruefen(s_Pfad, c_TeilPfad_Input, _
                                     Input-Verzeichnis)
      If s_PfadInput =  Then Exit Function
      
      s_PfadInputSave = Word_PfadPruefen(s_Pfad, c_TeilPfad_InputSave, _
                                         Sicherungs-Verzeichnis für Input)
      If s_PfadInputSave =  Then Exit Function
      
      s_PfadOutput = Word_PfadPruefen(s_Pfad, c_TeilPfad_Output, _
                                      Output-Verzeichnis)
      If s_PfadOutput =  Then Exit Function
      
      Word_PfadeBestimmen = True
        
    End Function
    '*******************************************************************************
    Private Function Word_PfadPruefen(s_Pfad As String, s_TeilPfad As String, _
                                      s_Bezeichnung_Ordner As String) As String
      
      Dim s_Pfad_komplett As String, ret As Integer
      
      Word_PfadPruefen = 
      
      s_Pfad_komplett = s_Pfad & s_TeilPfad
      
      If Dir(s_Pfad_komplett, vbDirectory) =  Then
        ret = MsgBox( _
          s_Bezeichnung_Ordner &  nicht vorhanden:  & s_Pfad_komplett & vbLf & _
          Soll das Verzeichnis angelegt werden ?, _
          vbQuestion + vbYesNo + vbDefaultButton2)
        If ret = vbYes Then
          On Error Resume Next
          MkDir (s_Pfad_komplett)
          If Err.Number <> 0 Then
            Err.Clear: On Error GoTo 0
            MsgBox (Fehler beim Anlegen des Verzeichnis. & vbLf & s_Pfad_komplett)
            Exit Function
          End If
          On Error GoTo 0
        Else
          Exit Function
        End If
      End If
    
      Word_PfadPruefen = s_Pfad_komplett
    End Function
    '*******************************************************************************
    Private Function DateiAuswaehlen(s_Dialog_titel As String, _
                                     f() As String, f_cnt As Long) As String
      
      Const c_BREITE_ZEILEANGABE = 3
      
      Dim l_zaehler As Long, s_tmp As String, s_r As String
      Dim l_AnzLeerzeichen As Long, l_AnzStellen As Long, x As Long
      Dim s_Nr As String, l_Nr As Long, y As Long, s As String
      
     ->Meldung zusammenstellen
      s_tmp = Bitte geben Sie den Index der auszuwählenden Datei an & vbLf & vbLf
      
      l_zaehler = 0
      For x = 1 To f_cnt
        s_r = x
        l_AnzLeerzeichen = c_BREITE_ZEILEANGABE - Len(s_r)
        If l_AnzLeerzeichen < 0 Then l_AnzLeerzeichen = 0
        l_AnzStellen = Len(s_r)
        s_tmp = s_tmp & Format(x, String(l_AnzLeerzeichen, _) & _
                        String(Len(s_r), 0)) & vbTab & f(x) & vbLf
        l_zaehler = l_zaehler + 1
      Next
      
     ->Meldung ausgeben und Auswahl
    Nochmal:
      s_Nr = InputBox(s_tmp, s_Dialog_titel, )
      If s_Nr <>  Then
        For y = 1 To Len(s_Nr)
          s = Mid(s_Nr, y, 1)
          Select Case s
            Case 0 To 9->zulässig
            Case Else
              MsgBox (Bitte nur eine Zahl eingeben.)
              GoTo Nochmal
          End Select
        Next
        l_Nr = s_Nr
        If l_Nr < 0 Or l_Nr > f_cnt Then
          MsgBox (Index zu groß.)
          GoTo Nochmal
        End If
      
       ->ausgewahlte Datei
        DateiAuswaehlen = f(l_Nr)
      Else
        DateiAuswaehlen = 
      End If
    End Function
     
  10. Hallo Matjes,

    ich habe das Makro in Ruhe ausprobiert und es klappt prima. Ich habe es direkt in meine Prozeduren- (und jetzt auch Makro-) sammlung übernommen.

    Ich habe mittlerweile auch eine Einführung zu Makro-Sprache, Objekten und VBA gefunden. Leider ist es keine vollständige Befehlsreferenz. Ich kann also nicht beurteilen, ob da eine Erweiterung möglich ist.

    Ich denke an eine Funktion, mit der ich aus einer geöffneten Zieldatei heraus eine andere .doc Datei ansprechen kann, wobei pro Makroaufruf eine Datei eingefügt wird. Die einzufügende Datei würde aus einer Liste der Dateien, die sich im aktuellen Verzeichnis der Zieldatei befinden ausgewählt werden.

    Meine Beschreibung schweigt schon zu der Frage, wie sich ein Makro unabhängig von einer Vorlage organisieren läßt und wie das Makro dann das aktuelle Arbeitsverzeichnis der geöffneten Zieldatei ermitteln kann.

    **
    Mit Verzeichnis meine ich hier einen Ordner.
     
Die Seite wird geladen...

Dateien in Word zusammenfügen - Ähnliche Themen

Forum Datum
Öffnen mit Doppelklick funktioniert bei Word u. Excel Dateien nichtmehr Microsoft Office Suite 10. Feb. 2015
Windows 8.1 zeigt bei von Word 2013 erstellten Dateien immer .xml als Endung an Windows 8 Forum 26. Juni 2014
Word-Dateien mit ~$ Microsoft Office Suite 3. Aug. 2013
Windows Live Mail kann keine Word-PdF Dateien öffnen Software: Empfehlungen, Gesuche & Problemlösungen 7. Dez. 2011
Fehlermeldung beim Öffnen von Word-Dateien Microsoft Office Suite 27. Juli 2013