simulate tag clound in word doc with VBA

[sumGirl]

Hey all. Is it possible to simulate a tag cloud in a word doc using
only VBA? I dont need the words to be hyperlinks, I would just like to
have the font size of each word set to a size based on the frequency
the word is used throughout the doc.

Thanks in advance!
-sG

 

[Jezebel]

Sure. Count the occurrence of each word, then set the font size accordingly.

 

[sumGirl]

Wow...what a useful reply. That never would have occurred to me. Maybe
someone with some VBA help could reply?

 

[Jean-Guy Marcil]

sumGirl was telling us:
sumGirl nous racontait que :

Wow...what a useful reply. That never would have occurred to me. Maybe
someone with some VBA help could reply?

This reply was meant, I think, to show you that what you are asking is
nearly impossible as soon as you work with real document (Tables, sections
breaks, hyphens, page breaks, punctuation, etc.)
And what if a word is found 200 times? And in the same document another is
found only once? You will have 200 hundred words at font size 200 and one at
font size 1?

In any case, here's a little something to get you going.
You are re going to need to add error trapping of all sorts and try to
foresee all kinds of undesirable stuff that may end up in your document that
should be ignored.
I put the entire doc in a string otherwise the processing would take too
long...

'_______________________________________
Sub ProcessWords()

Dim strDoc As String
Dim strDocArray() As String
Dim i As Long
Dim k As Long

strDoc = ActiveDocument.Range.Text

strDoc = Replace(strDoc, Chr(13), " ")
'Remove all double spaces from string
Do While InStr(1, strDoc, " ") > 0
strDoc = Replace(strDoc, " ", " ")
Loop
strDoc = Replace(strDoc, " ", "|")
'Convert to lowercase
strDoc = LCase(strDoc)
'Remove trailing "|"
Do While Right(strDoc, 1) = "|"
strDoc = Left(strDoc, Len(strDoc) - 1)
Loop
Do While Left(strDoc, 1) = "|"
strDoc = Right(strDoc, Len(strDoc) - 1)
Loop
strDocArray = Split(strDoc, "|")

WordBasic.SortArray strDocArray()

k = 1
i = 0

For i = 0 To UBound(strDocArray)
If i < UBound(strDocArray) Then
If strDocArray(i) <> strDocArray(i + 1) Then
ReplaceFontSize strDocArray(i), k
Else
k = k + 1
End If
End If
Next

'One more time as the last one was not done
'because we got to the end of the array
ReplaceFontSize strDocArray(UBound(strDocArray)), k

End Sub
'_______________________________________

'_______________________________________
Private Sub ReplaceFontSize(ByRef strWord As String, ByRef lngFontSize As
Long)

With ActiveDocument.Range.Find
.Text = strWord
.Replacement.Text = strWord
'5 is used so that we have a minimum font that is legible
.Replacement.Font.Size = 5 + lngFontSize
.Execute Replace:=wdReplaceAll
lngFontSize = 1
End With

End Sub
'_______________________________________

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

 

[sumGirl]

Thank you! There are some rules tht can be used to keep a handle on
words that will get out of control, as well as common rules like [the,
a, is] and the trick is to pick the most common word and establish that
as your ceiling...or largest font'ed word. Everything else is downhill
from there by percentage.