Schriftfarbe per Makro in Word 2003 suchen

Nexus8 · 28.11.2011

Ich möchte aus einem Word-2003-Dokument, das Text in verschiedenerlei Farbe enthält, alles herauslöschen, was nicht die Farbe dunkelblau hat. Wenn ich indes den Makro-Recorder aufrufe, um eine Folge von (tadellos funktionierenden) Suchen-und-Ersetzen-Operationen (z. B. Suche nach->^?', Schriftfarbe grün, Ersetzen durch->') aufzuzeichnen, wird beim Aufruf des aufgezeichneten Makros stets alles gelöscht, weil darin sämtliche als Auswahlkriterien vorgegebene Formatierungsmerkmale (interessanterweise nicht nur die Schriftfarbe, sondern auch z. B.->verborgen') fehlen.

Kann mir jemand weiterhelfen?

Matjes · 29.11.2011

Hallo Nexus8,

ich hab mal per Makro ein paar Versuche gemacht und dabei Unstimmigkeiten in der Farbe festgestellt.

Wenn man in Word2003 Text->Dunkelblau' einfärbt, erhält der Text die RGB-Farbe mit dem Wert 6299648.
Die Konstante wdColorDarkBlue für dunkelblaue Farbe hat aber den Wert 8388608.

Aus diesem Grund würde ein Makro, der mit der Konstanten wdColorDarkBlue arbeitet, danebengreifen.

Als Lösung kann ich dir ein Makro anbieten, der die Farbe zunächst aus der Selektion bestimmt, und dann Alles ungleich der Farbe löscht. Also Schreibmarke in Text setzen, der bestehenbleiben soll, und dann Makro ausführen.

Gruß Matjes

Code:

Sub NurTextMitFarbeDerSelectionUebriglassen()

 Dim doc As Document
 Dim lFarbe As Long, x As Long
  
 Set doc = ActiveDocument
 
 lFarbe = Selection.Font.Color
 If lFarbe = 9999999 Then MsgBox Bitte nur Text mit einer Farbe selektieren.: GoTo AUFRAEUMEN
 
 For x = doc.Content.End To doc.Content.Start + 1 Step -1
 
  If doc.Range(Start:=x - 1, End:=x).Font.Color &lt;> lFarbe Then
   doc.Range(Start:=x - 1, End:=x).Delete
  End If
 Next
 
AUFRAEUMEN:
 Set doc = Nothing
End Sub

Nexus8 · 29.11.2011

Vorneweg herzlichen Dank für die Mühe, ich dachte, das Problem wäre trivialer ...

Wenn ich nun jedoch das Makro über den VB-Editor von W2003 über die Zwischenablage importiere, anschließend wie beschrieben Text in der zu erhaltenden Farbe markiere und das Makro aufrufe, erhalte ich einen Laufzeitfehler 5904: Bereich kann nicht bearbeitet werden, wobei der Ablauf an der Zeile doc.Range(Start:=x - 1, End:=x).Delete
scheitert. (Liegt es vielleicht daran, daß es sich um eine Tabelle handelt?)

Ich bitte um Nachsicht, wenn die Ursache für das Scheitern in irgendeiner Eselei von mir liegen sollte: Meine Makro-Programmier-Kenntnis beschränkt sich auf die über den Makro-Recorder zugänglichen einfachen Funktionen. :-\

hddiesel · 29.11.2011

Hallo Matjes,

das Makro funktioniert mit Word XP(2002) einwandfrei; aber nur wenn keine Tabelle in das Dokument eingefügt wurde!

Jedes Zeichen mit einer anderen Farbe, als das Markierte wird im Dokument gelöscht.

Matjes · 30.11.2011

Hallo zusammen,

jetzt kann das Makro auch Tabellen

Vor dem Makrostart muß jetzt ein Zeichen imaktuellen Dokument selektiert werden, aus dem die Farbe der Zeichen bestimmt wird, die bestehen bleiben sollen.

(Man könnte auch das Makro umschreiben, so dass nur Zeichen dieser Farbe gelöscht werden)

Gruß Matjes

Code:

Sub NurTextMitFarbeDerSelectionUebriglassen()

 Dim doc As Document, myTab As Table
 Dim lFarbe As Long, x As Long, t As Long, z As Long, sp As Long, fTabsA As Long, fTabsE As Long
 Dim fTabsStart() As Long, fTabsEnd() As Long, fTabsCount As Long
  
 Set doc = ActiveDocument
 
->Farbe aus einem Zeichen bestimmen, welche erhalten werden soll
 If Selection.Start &lt;> Selection.End - 1 Then MsgBox Bitte ein Zeichen selektieren, dass erhalten bleiben soll.: GoTo AUFRAEUMEN
 lFarbe = Selection.Font.Color
 
->Tabellen-Anfang und -Ende feststellen
 fTabsCount = doc.Tables.Count
 If fTabsCount &lt;> 0 Then
  ReDim fTabsStart(1 To fTabsCount)
  ReDim fTabsEnd(1 To fTabsCount)
  For t = 1 To fTabsCount
   fTabsStart(t) = doc.Tables(t).Range.Start
   fTabsEnd(t) = doc.Tables(t).Range.End
  Next
 End If
 
 
->Zeichen ausserhalb von Tabellen bearbeiten
 t = fTabsCount
 If t > 0 Then
 ->Anfang und Ende der nächsten Tabelle einstellen
  fTabsA = fTabsStart(t)
  fTabsE = fTabsEnd(t)
 End If
 For x = doc.Content.End To doc.Content.Start + 1 Step -1
  If x = fTabsE Then
  ->Tabelle überspringen
   x = fTabsA + 1
  ->Anfang und Ende der nächsten Tabelle einstellen
   t = t - 1
   If t > 0 Then
    fTabsA = fTabsStart(t)
    fTabsE = fTabsEnd(t)
   Else
    fTabsE = 0
   End If
  Else
   If doc.Range(Start:=x - 1, End:=x).Font.Color &lt;> lFarbe Then
    doc.Range(Start:=x - 1, End:=x).Delete
   End If
  End If
 Next
 
->Zeichen innerhalb von Tabellen bearbeiten
 For Each myTab In doc.Tables
  For z = 1 To myTab.Rows.Count
   For sp = 1 To myTab.Columns.Count
   ->Zeichen mit auf letzte Absatzmarke bearbeiten
    For t = myTab.Cell(z, sp).Range.Characters.Count - 1 To 1 Step -1
     If myTab.Cell(z, sp).Range.Characters(t).Font.Color &lt;> lFarbe Then
      myTab.Cell(z, sp).Range.Characters(t).Delete
     End If
    Next
   Next
  Next
 Next
 
AUFRAEUMEN:
 Set doc = Nothing: Set myTab = Nothing
End Sub

hddiesel · 30.11.2011

Hallo Matjes,

Test mit Excel XP(2002) durchgeführt, hier mein Bericht.

Es sieht so aus, dass nicht nur eine vorhandene Tabelle im Dokument zum Fehler führt! :|

Beim 1. und 2. Makro kann nur ein schwarzes Zeichen markiert werden, wenn eine Tabelle im Dokument vorhanden ist, dann werden alle andersfarbigen Zeichen im Dokument außerhalb der Tabelle entfernt, wird ein Zeichen mit einer anderen Farbe als Schwarz markiert kommt es in der Zeile
doc.Range(Start:=x - 1, End:=x).Delete
zum Fehler und alle Zeichen bleiben erhalten. :'(

Ist keine Tabelle im Dokument enthalten, können auch andere Zeichen als Schwarze markiert werden und alle andersfarbigen Zeichen werden entfernt, sowohl mit dem 1. und 2. Makro. :1

Nexus8 arbeitet mit Excel 2003, vermutlich tritt hier der selbe Fehler auf.

Nexus8 · 01.12.2011

Hm, vielen Dank für neuerlichen Aufwand, allerdings scheitert die Ausführung (zur Erinnerung: in Word 2003) nun, wie ja bereits hddiesel feststellt, an einem anderen Laufzeitfehler; bei mir ist es allerdings 5941 (Das angeforderte Element ist nicht in der Sammlung vorhanden), und zwar in der Zeile
For t = myTab.Cell(z, sp).Range.Characters.Count - 1 To 1 Step -1. :-?

Ich habe das Problem indes nun doch - wenn auch auf zugegebenermaßen unelegante Weise - selbst lösen können: Wie ich mich erinnerte, habe ich auf einem Notebook noch Office 2000 installiert, und wie erhofft weist dessen Makro-Recorder den offenbar seit W2002 vorhandenen Bug einer unvollständigen Protokollierung nicht auf.

Noch einmal herzlichen Dank allen Beteiligten, besonders Matjes für seine Mühe!

Schriftfarbe per Makro in Word 2003 suchen

Nexus8

Matjes

Nexus8

hddiesel

Matjes

hddiesel

Nexus8

Schriftfarbe per Makro in Word 2003 suchen

ANGEBOTE & SPONSOREN

Neueste Themen

Statistik des Forums