WORD 6.0 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 6.0
ber

 "Extras / Makro / [Makroname]: 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") 

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

Sub MAIN
REM Makro erstellt 2007 von Juergen Hinrichs schul16@gmx.net

AnsichtNormal
BeginnDokument


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

BearbeitenSuchen .Suchen = " ^a", .Richtung = 0, .GroKleinschreibung = 0, .GanzesWort = 0, .Mustervergleich = 0, .Reserviert23 = 0, .Format = 0, .Textflu = 0

While BearbeitenSuchenGefunden() = - 1

BearbeitenErsetzen .Suchen = " ^a", .Ersetzen = "^a", .Richtung = 0, .AllesErsetzen, .Format = 0, .Textflu = 0

BeginnDokument
	BearbeitenSuchen

Wend

BeginnDokument

REM SETZT EINFGEMARKE
BearbeitenGeheZu .Ziel = "z1"
ZeilenNr = 0

REM Statt 'UMGEHT WAGENRCKLAUF'

EndeDokument
EinfgenAbsatz
BeginnDokument
EinfgenAbsatz

BeginnDokument
BearbeitenErsetzen .Suchen = "^a", .Ersetzen = "#E#^a#A#", .Richtung = 0, .AllesErsetzen, .Format = 0, .Textflu = 0

EndeDokument
EndeZeile
BeginnZeile 1
BearbeitenLschen

BeginnDokument
EndeZeile
BeginnZeile 1
BearbeitenLschen

REM DateiSpeichern
REM DokumentSchlieen
REM DateiListe 1


REM ENDE VORBEREITUNG



Start:

REM NUR BIS DOKUMENT ENDE Vorgehen
While TextmarkenVergleichen("\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):

EndeZeile
BeginnZeile 1


REM UMGEHT WAGENRCKLAUF - S.O.
REM Unzuverlssig

If Markierung$() = Chr$(13)  Then
REM MsgBox "ABSATZ!"
AbsatzUnten
Goto Start

Else

Zeile$ = Markierung$()
REM MsgBox Zeile$

BearbeitenErsetzen .Suchen = Zeile$, .Ersetzen = "", .Richtung = 0, .GroKleinschreibung = 1, .GanzesWort = 1, .Mustervergleich = 0, .Reserviert23 = 0, .EinenErsetzen, .Format = 0, .Textflu = 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

REM If BearbeitenSuchenGefunden() <> 0 Then
REM If BearbeitenSuchenGefunden() = - 1 Then
REM If BearbeitenSuchenGefunden() = 0 Then


While BearbeitenSuchenGefunden() = - 1

REM WIEDERHOLEN 

BearbeitenErsetzen .Suchen = Zeile$, .Ersetzen = "", .Richtung = 0, .GroKleinschreibung = 1, .GanzesWort = 1, .Mustervergleich = 0, .Reserviert23 = 0, .EinenErsetzen, .Format = 0, .Textflu = 0

AbsatzUnten

Wend

BearbeitenGeheZu .Ziel = ZeilenN$

Goto Start


REM GEHRT ZU DOKUMENTENDE
End If
Wend


REM NACHSPIEL
BeginnDokument


REM DateiSpeichern
REM DokumentSchlieen
REM DateiListe 1


BeginnDokument
BearbeitenErsetzen .Suchen = "#E#", .Ersetzen = "", .Richtung = 0, .AllesErsetzen, .Format = 0, .Textflu = 0

BeginnDokument
BearbeitenErsetzen .Suchen = "#A#", .Ersetzen = "", .Richtung = 0, .AllesErsetzen, .Format = 0, .Textflu = 0


REM OPTIONAL - ZIEHT TEXT ZUSAMMEN

BeginnDokument

BearbeitenSuchen .Suchen = "^a^a^a", .Richtung = 0, .GroKleinschreibung = 0, .GanzesWort = 0, .Mustervergleich = 0, .Reserviert23 = 0, .Format = 0, .Textflu = 0

While BearbeitenSuchenGefunden() = - 1

BearbeitenErsetzen .Suchen = "^a^a^a", .Ersetzen = "^a^a", .Richtung = 0, .AllesErsetzen, .Format = 0, .Textflu = 0

REM BeginnDokument
	BearbeitenSuchen

Wend

BeginnDokument


End Sub


REM UNTERMAKRO

Function MarkPrf
	If AbrufenMarkierungAnfangPosition() = \
			AbrufenMarkierungEndePosition() 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 6.0 integrieren:

 "Extras / Anpassen / Mens / Kategorien: Makros"

Makro auswhlen und in ein Men einfgen


oder ber "Tastatur" mit einer Tastenkombination belegen, 


Alternativ das Makro direkt ber

 "Extras / Makro / [Makroname]: Ausfhren" 	

auswhlen und ausfhren lassen.




Einbau und Betrieb des Makros geschieht auf eigenes Risiko.

(c) 2007 Jrgen Hinrichs 
						
