WORD 97 Makro: DoppelZeilenWeg

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 DoppelZeilenWeg

Beseitigt redundante, d. h. doppelt vorkommende Zeilen (!) aus Texten. 

Dient dazu, aus e-Mails, Forenbeitrgen o. ., in denen wieder und wieder das Selbe zitiert wurde, oder aus mit AllIn1 zusammengenieteten Texten jede Zeile zu entfernen, die bereits einmal im Text vorgekommen ist. 

Tabellen bitte vorher mit "Tabelle Markieren" / "Tabelle in Text" 
in Text umwandeln. 


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


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 Main" bzw. "End Function") 

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

Rem Makro erstellt 2007 von Juergen Hinrichs schul16@gmx.net


Public Sub MAIN()
Dim ZeilenNr
Dim ZeilenN$
Dim Zeile$

WordBasic.ViewNormal
WordBasic.StartOfDocument


Rem Beseitigt Leerzeichen am Ende der Zeilen
Rem Beseitigt Leerzeilen - geht; Muss sein, aber Unzuverlssig

WordBasic.EditFind Find:=" ^a", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0

While WordBasic.EditFindFound() = -1

WordBasic.EditReplace Find:=" ^a", Replace:="^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.StartOfDocument
    WordBasic.EditFind

Wend

WordBasic.StartOfDocument

Rem SETZT EINFGEMARKE
WordBasic.WW7_EditGoTo Destination:="z1"
ZeilenNr = 0

Rem Statt 'UMGEHT WAGENRCKLAUF'

WordBasic.EndOfDocument
WordBasic.InsertPara
WordBasic.StartOfDocument
WordBasic.InsertPara

WordBasic.StartOfDocument
WordBasic.EditReplace Find:="^a", Replace:="#E#^a#A#", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.EndOfDocument
WordBasic.EndOfLine
WordBasic.StartOfLine 1
WordBasic.WW6_EditClear

WordBasic.StartOfDocument
WordBasic.EndOfLine
WordBasic.StartOfLine 1
WordBasic.WW6_EditClear

Rem DateiSpeichern
Rem DokumentSchlieen
Rem DateiListe 1

Rem ENDE VORBEREITUNG



Start:

Rem NUR BIS DOKUMENT ENDE Vorgehen
While WordBasic.CmpBookmarks("\Sel", "\EndOfDoc")


    ZeilenNr = ZeilenNr + 1
Rem MsgBox Str$(ZeilenNr)
    ZeilenN$ = "z" + Str(ZeilenNr)
Rem MsgBox ZeilenN$


Rem MARKIEREN UND MERKEN

Rem Markiert die aktuelle Zeile ohne die Absatzmarke
Rem (wenn sich am Zeilenende eine Absatzmarke befindet):

WordBasic.EndOfLine
WordBasic.StartOfLine 1


Rem UMGEHT WAGENRCKLAUF - S.O.
Rem Unzuverlssig

If WordBasic.[Selection$]() = Chr(13) Then
Rem MsgBox "ABSATZ!"
WordBasic.ParaDown
GoTo Start

Else

Zeile$ = WordBasic.[Selection$]()
Rem MsgBox Zeile$

WordBasic.EditReplace Find:=Zeile$, Replace:="", Direction:=0, MatchCase:=1, WholeWord:=1, PatternMatch:=0, SoundsLike:=0, ReplaceOne:=1, Format:=0, Wrap:=0

Rem Unbedingt zusammenlassen, Markierung ist nicht gleich Zwischenablage!
Rem Textflu=0 hier unbedingt! Sonst geht IF nicht bei BeginnZeile!!


Rem PRFT OB DIE MARKIERUNG GRSSER IST ALS 0 - HIER SINNLOS
Rem If MarkPrf = 0 Then MsgBox "Keine Markierung vorhanden."

Rem ENDE PRFUNG


Rem BEDINGUNG PRFEN


While WordBasic.EditFindFound() = -1

Rem WIEDERHOLEN

WordBasic.EditReplace Find:=Zeile$, Replace:="", Direction:=0, MatchCase:=1, WholeWord:=1, PatternMatch:=0, SoundsLike:=0, ReplaceOne:=1, Format:=0, Wrap:=0

WordBasic.ParaDown

Wend

WordBasic.WW7_EditGoTo Destination:=ZeilenN$

GoTo Start


Rem GEHRT ZU DOKUMENTENDE
End If
Wend


Rem NACHSPIEL
WordBasic.StartOfDocument


Rem DateiSpeichern
Rem DokumentSchlieen
Rem DateiListe 1


WordBasic.StartOfDocument
WordBasic.EditReplace Find:="#E#", Replace:="", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

WordBasic.StartOfDocument
WordBasic.EditReplace Find:="#A#", Replace:="", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0


Rem OPTIONAL - ZIEHT TEXT ZUSAMMEN

WordBasic.StartOfDocument

WordBasic.EditFind Find:="^a^a^a", Direction:=0, MatchCase:=0, WholeWord:=0, PatternMatch:=0, SoundsLike:=0, Format:=0, Wrap:=0

While WordBasic.EditFindFound() = -1

WordBasic.EditReplace Find:="^a^a^a", Replace:="^a^a", Direction:=0, ReplaceAll:=1, Format:=0, Wrap:=0

Rem BeginnDokument
    WordBasic.EditFind

Wend

WordBasic.StartOfDocument


End Sub


Rem UNTERMAKRO

Private Function MarkPrf()
    If WordBasic.GetSelStartPos() = _
            WordBasic.GetSelEndPos() Then
        MarkPrf = 0
    Else
        MarkPrf = 1
    End If
End Function
    


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

Einige Makros sind so umfangreich, da sie bei greren Texten und geringem Arbeitsspeicher die Fhigkeit von MS WORD berschreiten sich zurckliegende Schritte zu merken. Das beeintrchtigt jedoch nicht die Funktion des Makros. In diesem Fall die Meldung: "Unzureichender Arbeitspeicher. Sie knnen diesen Vorgang nicht rckgngig machen. Fortfahren?" mit J (Ja), Eingabe- oder der Leertaste besttigen. Um dieses zu umgehen knnen grere Texte abschnittsweise in einem separaten Fenster bearbeiten werden.



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) 2007 Jrgen Hinrichs 


