Remove characters *not* of a specified font size

[Joel]

I would appreciate help in writing a macro that removes from a document all
characters of any font size other than the size specified in the macro. In
the docs I'm working with, these unwanted characters tend to occur in bunches
ending with a paragraph mark, so ideally the macro would remove the paragraph
mark as well, although this isn't as important.

I'm using Word 2003.

Thanks.

 

[Russ]

Joel,
Read this recent thread to see the similar topic discussed earlier.

http://snipurl.com/sue1

Will that work for you?

 

[Klaus Linke]

I would appreciate help in writing a macro that removes from a document all
characters of any font size other than the size specified in the macro.
In
the docs I'm working with, these unwanted characters tend to occur in
bunches
ending with a paragraph mark, so ideally the macro would remove the
paragraph
mark as well, although this isn't as important.

I'm using Word 2003.

Hi Joel,

Another pretty simple method:
Replace the font size with some font formatting that does not occur, say
"Format > Font > Shadow".
Then delete anything that is not shadowed with a second Replace.

Regards,
Klaus

 

[Joel]

That is an informative exchange, for which thanks. I've opted to use the
"nontransplantation" approach suggested by Klaus Linke, however.

Thanks again.

 

[Joel]

Thank you, Klaus. I've followed your suggestion. (But is there really no
way to say something like ".font.size <> 12"?)

 

[Klaus Linke]

(But is there really no way to say something like ".font.size <> 12"?)


No. I'm tempted to write something general for that kind of Replacement...
Maybe if the question comes up enough times <g>

Another general Find/Replace that would be useful sometimes is to toggle
something -- say "hidden" becomes "not-hidden" and vice versa...
That's also something that seems easy enough to ask for, but is difficult in
reality.

Klaus

 

[Robert M. Franz (RMF)]

Klaus Linke wrote:
[..]

Another general Find/Replace that would be useful sometimes is to toggle
something -- say "hidden" becomes "not-hidden" and vice versa...
That's also something that seems easy enough to ask for, but is difficult in
reality.

.... and looping through the document character-wise might take a bit
more of the user's patience?

Greetinx
Robert

 

[Helmut Weber]

Hi Robert,

... and looping through the document character-wise might take a bit
more of the user's patience?

indeed.
Therefore, if it has to be,
loop through storyranges, sections, paragraphs, words, characters,
successively,
like, very much abbreviated:

Sub test00486()
Dim rPrg As Paragraph
Dim rWrd As Range ' a word
Dim rChr As Range ' a character
Dim StandardFontSize As Long
StandardFontSize = 12
For Each rPrg In ActiveDocument.Paragraphs
If rPrg.Range.Font.Size <> StandardFontSize Then
For Each rWrd In rPrg.Range.Words
If rWrd.Font.Size <> StandardFontSize Then
For Each rChr In rWrd.Characters
If rChr.Font.Size <> StandardFontSize Then
rChr.Font.Color = wdColorRed
rChr.Font.Bold = True
End If
Next
End If
Next
End If
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

Ha...

one could utilize sentences as well.
Certainly not for beginners.

Sub test00486x()
Dim rPrg As Paragraph ' a paragraph
Dim rSnt As Range ' a sentence
Dim rWrd As Range ' a word
Dim rChr As Range ' a character
Dim StandardFontSize As Long
StandardFontSize = 12
For Each rPrg In ActiveDocument.Paragraphs
If rPrg.Range.Font.Size <> StandardFontSize Then
For Each rSnt In rPrg.Range.Sentences
If rSnt.Font.Size <> StandardFontSize Then
For Each rWrd In rPrg.Range.Words
If rWrd.Font.Size <> StandardFontSize Then
For Each rChr In rWrd.Characters
If rChr.Font.Size <> StandardFontSize Then
rChr.Font.Color = wdColorRed
rChr.Font.Bold = True
End If
Next
End If
Next
End If
Next
End If
Next
End Sub

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Helmut Weber]

Hi Joel,

depending on your doc's structure,
this one might be pretty fast:

Sub RemoveUnequal(lSiz As Long)
Dim rPrg As Paragraph ' a paragraph
Dim rSnt As Range ' a sentence
Dim rWrd As Range ' a word
Dim rChr As Range ' a character
Dim lTmp As Long ' a temporary font size

ActiveDocument.Characters.Last.Font.Size = lSiz
' preventing an endless loop
' as the last paragraph mark in a doc can't be deleted

For Each rPrg In ActiveDocument.Paragraphs
lTmp = rPrg.Range.Font.Size
If lTmp <> lSiz And lTmp <> 9999999 Then
rPrg.Range.Delete
End If
If lTmp = 9999999 Then
For Each rSnt In rPrg.Range.Sentences
lTmp = rSnt.Font.Size
If lTmp <> lSiz And lTmp <> 9999999 Then
rSnt.Delete
End If
If lTmp = 9999999 Then
For Each rWrd In rSnt.Words
lTmp = rWrd.Font.Size
If lTmp <> lSiz And lTmp <> 9999999 Then
rWrd.Delete
End If
If lTmp = 9999999 Then
For Each rChr In rWrd.Characters
If rChr.Font.Size <> lSiz Then
rChr.Delete
End If
Next
End If
Next
End If
Next
End If
Next
End Sub

Sub Test63401()
RemoveUnequal 12
End Sub

The idea, explained for beginners, is to check
first paragraphs, then sentences, then words, then characters.
Font.size returns 9999999, if there are different font sizes.
So if the font.size is <> 9999999 and <> 12,
the range has a uniform font.size <> 12 and can be deleted.
Otherwise, we proceed to the next smaller unit, sentences,
and repeat the check for the font.size...

HTH

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

Win XP, Office 2003
"red.sys" & Chr$(64) & "t-online.de"

 

[Russ]

Brilliant! Helmut,

Logic would imply, that with a little extra testing, you might also speed
things up by also testing larger chunks like:

the whole document with ActiveDocument.Range
and
For Each rSec In ActiveDocument.Sections

 

[Joel]

Very nice. Thank you.