Help with a Macro for Word

M

MKruer

The macro is very simple. I want to find the font size other then
default and insert a tag before and after the text to list the font
size.

I am running into two issues
First, getting the default font size for the document.
Second, I think I broke my current script and I can't figure out
where it went wrong LOL.

Any help would be appreciated.

-TIA-

Code: 
Private Sub ConvertSize()

Dim fSize&

If convertFontSize = False Then Exit Sub

If DefaultFontSize = 12 Then DefaultFontSize = 12
fSize = 12

For fSize = 1 To 50
If fSize > DefaultFontSize + 1 Or fSize < DefaultFontSize - 1 Then
'at least two points difference
ActiveDocument.Select
With Selection.Find

.ClearFormatting
.Font.Size = fSize
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue

Do While .Execute
With Selection

If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
' Just process the chunk before any newline
characters
' We'll pick-up the rest with the next search
.Collapse
.MoveEndUntil vbCr
End If

' Don't bother to markup newline characters
(prevents a loop, as well)
If Not .Text = vbCr Then
If fSize = DefaultFontSize Then
.InsertBefore "[size=" & fSize & "]"
.InsertAfter "[/size]"
End If
End If

If useDefaultStyle Then .Style =
ActiveDocument.Styles(DefaultStyleName) 'must be localized to your
language, see CONST on top
.Font.Size = DefaultFontSize
'.Collapse wdCollapseEnd
'.MoveLeft , 4, True
'ClearFormatting

End With
Loop
End With
End If
Next

End Sub
 
H

Helmut Weber

Hi,

I don't know of a default font size for a document.
You may mean the font size of the paragraph template "normal",
like this:

MsgBox ActiveDocument.Styles("Normal").Font.Size

The rest of the job depends so much
on the document's structure and size,
that is is almost impossible to give an advice.

If every second string longer then one
is of a different size than the next or
the preceding string and the document is very large,
then the approach could be quite different
from dealing with a simple and short document
with large strings of the same font size.

As to your code:
If DefaultFontSize = 12 Then DefaultFontSize = 12 Doesn't make sense.
fSize = 12
Click to expand...
ok. fsize = 12
and now fsize takes on the values from 1 to 50
For fSize = 1 To 50
Click to expand...
which doesn't make sense either.
If Not .Text = vbCr Then
If fSize = DefaultFontSize Then
.InsertBefore "[size=" & fSize & "]"
.InsertAfter "[/size]"
End If
End If
Click to expand...

Would mean, you tag only text with the default fontsize,
then you wouldn't need a loop a all.

hm..., I wonder.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

MKruer

Helmut said:
Hi,

I don't know of a default font size for a document.
You may mean the font size of the paragraph template "normal",
like this:

MsgBox ActiveDocument.Styles("Normal").Font.Size

The rest of the job depends so much
on the document's structure and size,
that is is almost impossible to give an advice.

If every second string longer then one
is of a different size than the next or
the preceding string and the document is very large,
then the approach could be quite different
from dealing with a simple and short document
with large strings of the same font size.
Click to expand...

I think that it is a reasonable assumption that the default size would
be the size specified in the nomal.dot. The only other way that I would
think that you could find the "default" size would be to search the
document and find the size that occurs the most. This however would
take up too much processing.
As to your code:
If DefaultFontSize = 12 Then DefaultFontSize = 12 Doesn't make sense.
fSize = 12
Click to expand...
ok. fsize = 12
and now fsize takes on the values from 1 to 50
For fSize = 1 To 50
Click to expand...
which doesn't make sense either.
If Not .Text = vbCr Then
If fSize = DefaultFontSize Then
.InsertBefore "[size=" & fSize & "]"
.InsertAfter "[/size]"
End If
End If
Click to expand...

Would mean, you tag only text with the default fontsize,
then you wouldn't need a loop a all.
Click to expand...

The original, original code came from a Macro Word2MediaWikiPlus. In it
the original values were 10 and 12, and only included a change between
Large and Small, or 9pt and 18pt fonts. I was looking to refine this
system to be more robust by allowing for any size fonts.
 
J

Jean-Guy Marcil

(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :
I think that it is a reasonable assumption that the default size would
be the size specified in the nomal.dot. The only other way that I
would think that you could find the "default" size would be to search
the document and find the size that occurs the most. This however
would take up too much processing.
Click to expand...

Helmut meant the font size defined in the style named "Normal", not the
default size of the template called "Normal,dot".
As Helmut, wrote, there is not such thing as a default font size for a
document, but the default style is the "Normal" style (A newly created blank
document from the Normal.dot template contains a single paragraph with the
Normal style applied).

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org
 
M

MKruer

Thanks,

Thats even better.


Jean-Guy Marcil said:
(e-mail address removed) was telling us:
(e-mail address removed) nous racontait que :


Helmut meant the font size defined in the style named "Normal", not the
default size of the template called "Normal,dot".
As Helmut, wrote, there is not such thing as a default font size for a
document, but the default style is the "Normal" style (A newly created blank
document from the Normal.dot template contains a single paragraph with the
Normal style applied).

--
Salut!
_______________________________________
Jean-Guy Marcil - Word MVP
(e-mail address removed)
Word MVP site: http://www.word.mvps.org
Click to expand...
 
M

MKruer

I must be loosing it. Can someone take a look and tell me why this is
not working correctly.

-TIA-

Private Sub ConvertSize()

Dim CurrentFontSize&
Dim DocFontSize&


DocFontSize = ActiveDocument.Styles("Normal").Font.Size

For CurrentFontSize = 1 To 72

ActiveDocument.Select
With Selection.Find

.ClearFormatting
.Font.Size = DocFontSize
.Text = ""
.Format = True
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
.Forward = True
.Wrap = wdFindContinue

Do While .Execute
With Selection

If Len(.Text) > 1 And InStr(1, .Text, vbCr) Then
' Just process the chunk before any newline
characters
' We'll pick-up the rest with the next search
.Collapse
.MoveEndUntil vbCr
End If
'DiffFontSize = CurrentFontSize - DefaultFontSize

' Don't bother to markup newline characters
(prevents a loop, as well)
If .Text = vbCr Then
If CurrentFontSize = DocFontSize Then
.InsertBefore "[size=" & CurrentFontSize -
DocFontSize & "]"
.InsertAfter "[/size]"
End If
End If

If useDefaultStyle Then .Style =
ActiveDocument.Styles(DefaultStyleName) 'must be localized to your
language, see CONST on top
.Font.Size = DocFontSize

End With
Loop
End With
'End If
Next

End Sub
 
H

Helmut Weber

Hi MKruer,
Can someone take a look and tell me why this is
not working correctly.
Click to expand...

forgive me for an excursus into theory,
but in informatics there is nothing like
"correct" or "failure" or even "error" or so,
in a very strict sense, IMHO.

What is called "correct" is defined by your expectations.
What do you expect?

If the default font size is 14 and you want to tag
all text of size 14, except paragraph marks, then:

Sub Macro6()
' tag all text of font size 14
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Font.Size = 14
While .Execute
rDcm.InsertBefore "[14]"
If Right(rDcm, 1) = Chr(13) Then
rDcm.End = rDcm.End - 1
rDcm.InsertAfter "[14]"
rDcm.Start = rDcm.End + 2
Else
rDcm.InsertAfter "[14]"
End If
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End Sub

If you want to tag all text except of font size 14,
in the range from 1 to 50, then:

Sub Macro6x()
' tag all text of font size <> 14
Dim rDcm As Range
Dim l As Long
Set rDcm = ActiveDocument.Range
' set all paragraph marks to standard value
' and exclude them by this from processing
With rDcm.Find
.Text = Chr(13)
While .Execute
rDcm.Font.Size = 14
Wend
End With

Set rDcm = ActiveDocument.Range
For l = 1 To 50
If l <> 14 Then
With rDcm.Find
.Font.Size = l
While .Execute
rDcm.Select ' for testing only
rDcm.Font.Size = 14
rDcm.InsertBefore "[" & l & "]"
rDcm.InsertAfter "[" & l & "]"
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End If
Next
End Sub

Well, I wonder...

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

MKruer

I think I need to go back and relearn VB. Thanks for the code snippet.
I noticed that it only runs through the page once which is a good
thing, but it doesn't maker anything higher then the specified front
for some reason. Also what I was trying to accomplish with the normal
text was to find what font the user was using and base all the scaling
upon that. The document has 10pt as the normal then we should assume
that what they consider 8pt font is really 10pt font when normalized
against the web standard 12pt font.

Sub Macro7()

' tag all text of font size <> dfSize
Dim rDcm As Range
Dim l As Long
Dim m As Long

m = ActiveDocument.Styles("Normal").Font.Size
'get the curent normal size of the document

Set rDcm = ActiveDocument.Range
' set all paragraph marks to standard value
' and exclude them by this from processing
With rDcm.Find
.Text = Chr(13)
While .Execute
rDcm.Font.Size = 12
Wend
End With

Set rDcm = ActiveDocument.Range
For l = 1 To 72
If l <> 72 Then
With rDcm.Find
.Font.Size = l
While .Execute
rDcm.Select ' for testing only
rDcm.Font.Size = 12
rDcm.InsertBefore "[size=" & l & "]"
rDcm.InsertAfter "[/size]"
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End If
Next
End Sub


Helmut said:
Hi MKruer,
Can someone take a look and tell me why this is
not working correctly.
Click to expand...

forgive me for an excursus into theory,
but in informatics there is nothing like
"correct" or "failure" or even "error" or so,
in a very strict sense, IMHO.

What is called "correct" is defined by your expectations.
What do you expect?

If the default font size is 14 and you want to tag
all text of size 14, except paragraph marks, then:

Sub Macro6()
' tag all text of font size 14
Dim rDcm As Range
Set rDcm = ActiveDocument.Range
With rDcm.Find
.Font.Size = 14
While .Execute
rDcm.InsertBefore "[14]"
If Right(rDcm, 1) = Chr(13) Then
rDcm.End = rDcm.End - 1
rDcm.InsertAfter "[14]"
rDcm.Start = rDcm.End + 2
Else
rDcm.InsertAfter "[14]"
End If
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End Sub

If you want to tag all text except of font size 14,
in the range from 1 to 50, then:

Sub Macro6x()
' tag all text of font size <> 14
Dim rDcm As Range
Dim l As Long
Set rDcm = ActiveDocument.Range
' set all paragraph marks to standard value
' and exclude them by this from processing
With rDcm.Find
.Text = Chr(13)
While .Execute
rDcm.Font.Size = 14
Wend
End With

Set rDcm = ActiveDocument.Range
For l = 1 To 50
If l <> 14 Then
With rDcm.Find
.Font.Size = l
While .Execute
rDcm.Select ' for testing only
rDcm.Font.Size = 14
rDcm.InsertBefore "[" & l & "]"
rDcm.InsertAfter "[" & l & "]"
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End If
Next
End Sub

Well, I wonder...

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

Helmut Weber

Hi,

Sub Macro7x()

' tag all text of font size <> dfSize
Dim rDcm As Range
Dim l As Long
Dim m As Long


' m = ActiveDocument.Styles("Standard").Font.Size ' german
m = ActiveDocument.Styles("Normal").Font.Size ' english
'get the curent normal size of the document


Set rDcm = ActiveDocument.Range
' set all paragraph marks to standard value
' and exclude them by this from processing
With rDcm.Find
.Text = Chr(13)
While .Execute
rDcm.Font.Size = m ' <<<
Wend
End With

For l = 1 To 72
Set rDcm = ActiveDocument.Range ' <<<<
If l <> m Then ' <<<<
With rDcm.Find
.Font.Size = l
While .Execute
rDcm.Select ' for testing only
rDcm.Font.Size = m ' <<<<<<<<<<<<<
rDcm.InsertBefore "[size=" & l & "]"
rDcm.InsertAfter "[/size]"
rDcm.start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End If
Next
End Sub
 
M

MKruer

Now it is working much, much better. Thank you. I corrected the ability
to adjust the font size based upon 12pt so now if the document is set
to 10pt, it treats all fonts as if 10pt was actually 12pt and adds the
fonts size accordingly.

The is one more question though, and I am not sure if its just my
document or a bug in the code. When it comes to 12pt fonts, it always
skips encoding it with the correct tag. I walk through the debug and it
looks like it should work, but it doesn't. Any ideas

Also if you don't mind I would like to include your name in the
credits, its only fair.

Final output (Base 10pt font)

7
8
9
10
11
12
13
14



'Special thanks to Helmut Weber for help with coding and efficiency.

Sub ConvertSize()

' tag all text of font size <> dfSize
Dim rDcm As Range
Dim l As Long
Dim m As Long
Dim n As Long

' m = ActiveDocument.Styles("Standard").Font.Size ' german
m = ActiveDocument.Styles("Normal").Font.Size ' english
'get the curent normal size of the document
n = m - 12
'calculate the differencebetween the normal size of the document and
the web size (12)

Set rDcm = ActiveDocument.Range
' set all paragraph marks to standard value
' and exclude them by this from processing
With rDcm.Find
.Text = Chr(13)
While .Execute
rDcm.Font.Size = m ' <<<
Wend
End With

For l = 1 To 72
Set rDcm = ActiveDocument.Range ' <<<<
If l <> m Then ' <<<<
With rDcm.Find
.Font.Size = l
While .Execute
rDcm.Select ' for testing only
rDcm.Font.Size = m ' <<<<<<<<<<<<<
rDcm.InsertBefore "[size=" & l - n & "]"
rDcm.InsertAfter "[/size]"
rDcm.Start = rDcm.End
rDcm.End = ActiveDocument.Range.End
Wend
End With
End If
Next
 
H

Helmut Weber

Hi MKruer,

by: If l <> m Then ' <<<<

tagging of 12 point size font is deliberately excluded,

or I am missing something essential.

--
Greetings from Bavaria, Germany

Helmut Weber, MVP WordVBA

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

MKruer

You are correct, however if you set the normal/standard front to 10pt
and run the script, it still skips making 12pt as 14pt. Its weird, try
it. make a blank page and fill it with text of various fonts, (I made a
number 7-18 and each number was set to the font size [7=7pt, 10=10pt,
14=14pt etc..] ) Then set the normal/standard font for the document
to10pt and then run the script, it skips marking the 12pt font at 14pt

(.Font.Size = l) this seems to be the area where it fails.
 
H

Helmut Weber

Hi,

this is my input:
4 5 6 7 8 9 10 11 12 13 14 15 16¶
whereby each number is formatted in the size of the number.

This is my output with your unchanged code.

4 5 6 [si-ze=9]7[/size]
8 9 10 [si-ze=13]11[/size] 12
13 [si-ze=16]14[/size] 15 16¶
 
M

MKruer

Ok I think I found the issue. I could change the default font size, but
not necessarily apply it to the document. So as it was going through it
would see a 10pt font, skip it, then come to the 12pt font and see that
it was also "normal" and skip it as well. It was only till after I
hit apply to the entire document that it fixed this issue.

I guess that pretty much closes out this thread.

Thanks for the help.

I will be starting a new one to convert lists into BBCode. I got a base
line, but its not that great.

Thanks Again.
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Word macro that can call cells out of Excel for a find and replace 0
Need help modifying code 0
Change a great number of words in word files, with a macro as short as possible. 5
Match style 0
VBA-Table Word 2019 - Move a selected text, from a cell to the adjacent cell to its right, by pressing the ENTER key 0
Making a macro only work on certain files 2
Macro to Select text from a point given to a specific word 2
Select Text to End of Footnote 9

Top