
WORD 97 Makro: Alles in ein Dokument 

Autor:
Jrgen Hinrichs
schul16@gmx.net
http://mitglied.lycos.de/erleuchtet/index-g.htm
Infos und Tips fr Word, Windows, Access, Excel, Internet

Dieses Makro unterliegt dem Urheberrecht und bleibt Eigentum des Autors.
Es ist Freeware und darf unter Nennung des Autors und der Herkunft
unentgeltlich weitergegeben werden.

Es darf weder verkauft noch verliehen noch anderweitig kommerziell
vertrieben werden, auch nicht in genderter oder erweiterter Form.

Jedwede Haftung wird ausgeschlossen.
Weitere Makros auf Anfrage.


###############

Makro W7ALLIN1

Dieses Makro liest bis zu 50 in Word 97 offene Dokumente aus und fgt sie einzeln in ein neues Dokument mit dem Namen `Zusammenfassung ein. Anschlieend wird ein grobes Inhaltsverzeichnis erstellt. 

Die offenen Dokumente sollten zur Sicherheit vorher einmal gespeichert worden sein und sollten keine eigenen Word-Inhaltsverzeichnisse enthalten. 

Das Makro dient hauptschlich dazu, auf der Festplatte herumliegende Textdateien mit Informationsschnipseln oder im Laufe des Tages erstellte WORD-Dokumente zusammenzufassen.

Geschickte Menschen knnen es vielleicht mit dem Makro W7DELETE.ZIP kombinieren, um die bereits ausgelesenen Dokumente automatisch zu lschen oder zu verschieben. 

Nicht getestet in WORD 2000. 


###############


Den unten stehenden Makro- Code kopieren und in MS WORD 97
ber

 "Extras / Makro / Makros: Erstellen"

unter einem ausgewhlten Namen vollstndig in das sich ffnende Editor- Fenster einfgen.


CODE AB HIER KOPIEREN (inklusive der Anfangs- und Endzeilen mit "Sub / End Sub") 

+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++


Public Sub Main()

Dim n
Dim Datei$
Dim a$
Dim b$
Dim FenName$
Dim FenName1$
Dim FenName2$

Y = WordBasic.MsgBox("Dieses Makro liest bis zu 50 in Word offene Dokumente aus und fgt sie einzeln in ein neues Dokument mit dem Namen `Zusammenfassung ein. Die Dokumente sollten vorher einmal gespeichert worden sein und keine Word-Inhaltsverzeichnisse enthalten. Weiter?", "Alles in einem Dokument zusammenfassen", 36)

    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo Start
    
    
Start:

If Windows.Count < 1 Then GoTo Fertig

WordBasic.FileNewDefault
WordBasic.InsertPara
WordBasic.Insert "Zusammenfassung"
WordBasic.InsertPara

    Y = WordBasic.MsgBox("Das soeben erstellte Dokument `Zusammenfassung wird jetzt gespeichert. Weitermachen?", "Frage 1", 36)
    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo OK1

OK1:

' On Error Resume Next
' WordBasic.FileSave

    ActiveDocument.SaveAs FileFormat:=wdFormatDocument

    MsgBox "Das Dokument wurde gespeichert als:  " + WordBasic.[FileName$]()

    Y = WordBasic.MsgBox("Das Dokument wird jetzt zur Sicherung geschlossen und wieder geffnet. Das kann einen Moment dauern. Bitte in die Vorgnge nicht eingreifen. Weitermachen?", "Frage 2", 36)
    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo OK2

OK2:

 WordBasic.DocClose
 WordBasic.FileList 1

FenName$ = WordBasic.[WindowName$]()      ' Get Fenster Name allg
FenName1$ = WordBasic.[WindowName$](1)    ' Get Fenster1 Name
 On Error Resume Next
FenName2$ = WordBasic.[WindowName$](2)    ' Get Fenster2 Name
 On Error GoTo Ende

WordBasic.ViewNormal
WordBasic.StartOfDocument

' Y = WordBasic.MsgBox("Gespeichert und wieder offen; - Weiter?", "Frage 2a", 36)
'     If Y <> -1 Then GoTo Ende
'     If n <> -1 Then GoTo Weiter1

Weiter1:

If Windows.Count < 2 Then GoTo Fertig

WordBasic.EditReplace Find:="Zusammenfassung"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
WordBasic.InsertPara
WordBasic.InsertPara

    Application.WindowState = wdWindowStateMaximize

Y = WordBasic.MsgBox("Bereit zum Auslesen der in Word offenen Dokumente.  Durchfhren?", "Frage 3", 36)

    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo Schleife

' MsgBox "Suche erste Datei"

Schleife:

Rem DOKUMENTE EINFGEN

    For n = 1 To 50

Rem On Error GoTo -1:
On Error GoTo Fertig

WordBasic.InsertPara
WordBasic.InsertPara
WordBasic.InsertPara

FenName1$ = WordBasic.[WindowName$](1)    ' Get Fenster1 Name

WordBasic.Insert "Dokument" + Str(n) + ": " + FenName1$
WordBasic.InsertPara
WordBasic.LineUp 1
WordBasic.EndOfLine 1
WordBasic.FormatStyle Name:="berschrift 2", Apply:=1
WordBasic.EndOfLine
WordBasic.InsertPara
WordBasic.FormatStyle Name:="Standard", Apply:=1
WordBasic.InsertPara
WordBasic.InsertPara

Rem EIGENES DOKUMENT VERMEIDEN

Datei$ = WordBasic.[FileName$]()
a$ = WordBasic.[FileNameInfo$](Datei$, 4)
b$ = WordBasic.[FileNameInfo$](Datei$, 4) + ".doc"

Rem TEST ZIEL

' MsgBox "Zieldatei: " + b$

Rem TEST QUELLE FENSTER 1 -a

' MsgBox "Wechsle zur Quelle in Fenster 1"
    Windows(1).Activate
    
FenName$ = WordBasic.[WindowName$]()    ' Get Fenster Name neu
    
    Selection.MoveRight Unit:=wdCharacter, Count:=1
   
' MsgBox "Bin jetzt in Fenster 1, Quelle: " + FenName$

' MsgBox "Fenster 1 - Quelle: Nr. " + Str(n) + "  / Name: " + FenName$

' Y = WordBasic.MsgBox("Prfe bereinstimmung von Quelle und Ziel. Weiter?", "Frage 3a", 36)
'     If Y <> -1 Then GoTo Ende
'     If n <> -1 Then GoTo PRUEFENEUBEREIN

PRUEFENEUBEREIN:

    If InStr(1, FenName$, a$, 1) Then GoTo Leider1 Else GoTo Fein

    If InStr(1, FenName1$, FenName2$, 1) Then GoTo Leider1 Else GoTo Fein

Leider1:

' MsgBox "Quelle und Ziel stimmen leider berein, gehe auf Quelle in Fenster 1 zum markieren"

    Windows(1).Activate

' MsgBox "Bin jetzt wo?"

Rem TEST QUELLE FENSTER 1 -b

FenName$ = WordBasic.[WindowName$]()    ' Get Fenster Name neu

' MsgBox "Bin in Fenster 1 - Quelle:  " + FenName$

    If InStr(1, FenName$, a$, 1) Then GoTo Leider2 Else GoTo Fein

Leider2:

' MsgBox "Quelle und Ziel stimmen immer noch berein, keine Quellen mehr offen. Beende Zusammenfassung."

    Windows(2).Activate

GoTo Fertig

Fein:

' MsgBox "Prfung erfolgt, Quelle und Ziel sind nicht identisch, extrahiere das folgende Fenster"

' Y = WordBasic.MsgBox("Extrahiere Quelle Nr. " + Str(n) + ":  " + FenName$, "Frage 3b", 36)
'     If Y <> -1 Then GoTo Ende
'     If n <> -1 Then GoTo Weiter

Weiter:

    Windows(1).Activate

' MsgBox "Extrahiere Fenster 1: " + FenName$

    WordBasic.EditSelectAll
    WordBasic.EditCopy

    
' MsgBox "Quelle Nr. " + Str(n) + "  kopiert. Schliee jetzt das Fenster: `" + FenName$ + " "

' WordBasic.DocClose 2

    ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges

' Y = WordBasic.MsgBox("Kopierte Datei `" + FenName$ + " in Zusammenfassung einfgen?", "Frage 3c", 36)
'     If Y <> -1 Then GoTo Ende
'     If n <> -1 Then GoTo EINFUEGEN1

EINFUEGEN1:

' MsgBox "Suche Zielfenster zum Einfgen der Datei"

Rem If Windows.Count < 1 Then Windows(2).Activate Else GoTo WO

FenName$ = WordBasic.[WindowName$]()    ' Get Fenster Name neu

WO:

' MsgBox "Bin jetzt wo?"

FenName$ = WordBasic.[WindowName$]()    ' Get Fenster Name neu

' Y = WordBasic.MsgBox("Bin jetzt in " + FenName$ + "; kopierte Datei hier einfgen?", "Frage 3d", 36)
'     If Y <> -1 Then GoTo Ende
'     If n <> -1 Then GoTo EINFUEGEN2

EINFUEGEN2:

' MsgBox "Bin jetzt in " + FenName$
    
       
    WordBasic.EditPaste
    GoTo Ja
    On Error GoTo Nein

Nein:

MsgBox "Fehler. Habe Datei NICHT EINGEFGT. Beende Makro."
GoTo Ende

Ja:

    WordBasic.FileSave

' MsgBox "Datei Nr. " + Str(n) + " wurde eingefgt in: " + FenName$ + " . Suche nchste Quelle. "

Rem MIT ZWISCHENSPEICHERN, BEI GERINGEM ARBEITSSPEICHER, KEHRT DIE REIHENFOLGE UM

' WordBasic.DocClose
' WordBasic.FileList 1

WordBasic.InsertPara
WordBasic.InsertPara
WordBasic.InsertPara
WordBasic.Insert "++++++++++++++++++++++++++++++++++++++++++++++"
WordBasic.InsertPara
WordBasic.InsertPara
WordBasic.InsertPara

' MsgBox "Suche nchste Datei"

    Next

Fertig:

MsgBox "Keine weiteren Dokumente offen."

On Error Resume Next
WordBasic.EndOfDocument
On Error GoTo Fertig

Rem LETZTE BERSCHRIFT LSCHEN

Y = WordBasic.MsgBox("Zusammenfassung bearbeiten und beenden?", "Frage 4", 36)

    If Y <> -1 Then GoTo Ende
    If n <> -1 Then GoTo Clean

Clean:

On Error Resume Next
WordBasic.EditFind Find:="^$", Direction:=1, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0
On Error GoTo Ende

WordBasic.StartOfLine
WordBasic.EditFindStyle Style:="berschrift 2"
On Error GoTo Ende

WordBasic.StartOfLine
WordBasic.EditFind Find:="Dokument ^#", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0
On Error GoTo Ende

WordBasic.StartOfLine
WordBasic.EndOfLine 1
WordBasic.WW6_EditClear

Rem ENDE LSCHEN

WordBasic.StartOfDocument

WordBasic.EditReplace Find:="Zusammenfassung"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
WordBasic.InsertPara
WordBasic.InsertPara

On Error Resume Next
WordBasic.InsertTableOfContents Outline:=1, From:=1, To:=4, RightAlignPageNumbers:=1, Replace:=0
On Error GoTo Ende

Rem NORMAL SEITENBREITE

    If ActiveWindow.View.SplitSpecial = wdPaneNone Then
    ActiveWindow.ActivePane.View.Type = wdNormalView
    Else
    ActiveWindow.View.Type = wdNormalView
    End If
    ActiveWindow.ActivePane.View.Zoom.PageFit = wdPageFitBestFit

Ende:

MsgBox "Makro Ende"

End Sub


+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++





Neue Makros in MS WORD 97 integrieren:

 "Extras / Anpassen / Befehle / Kategorien: Makros"

Makro auswhlen und durch Ziehen mit der Maus in ein Men einfgen oder ber "Tastatur" mit einer Tastenkombination belegen, 



Alternativ das Makro direkt ber

 "Extras / Makro / Ausfhren" 	

auswhlen und ausfhren lassen.




Einbau und Betrieb des Makros geschieht auf eigenes Risiko.

(c) 2002 Jrgen Hinrichs




