Font size of -2 on some text boxes.

  • Thread starter Thread starter Mike M.
  • Start date Start date
M

Mike M.

I wrote a VB program to cycle through all shapes on all slides and see what
the font size is. Text boxes that have multiple font sizes show as -2. I
need to reduce the font size for all text in text boxes and I don't know how
to find where the different text ranges are within a text box. I guess I
could test each character and set the font size but I think that would be
too big of a processing hit. Any thoughts?

TIA

Private Sub cmdGo_Click()
Dim ppApp As PowerPoint.Application
Dim srcSlide As PowerPoint.Slide
Dim path As String
Dim srcPres As PowerPoint.Presentation
Dim cnt As Integer

Dim currShape As PowerPoint.Shape
Dim shapeCnt As Integer
Dim currTextFrame As PowerPoint.TextFrame
Dim fontSize As Integer

Set ppApp = CreateObject("PowerPoint.Application")

path = "c:\\myprojects\\vb_pres_dump\\test.ppt"
Set srcPres = ppApp.Presentations.Open(path, , , msoFalse)

With srcPres
' now do all slides
For cnt = 1 To .Slides.Count
Set srcSlide = .Slides(cnt)
For shapeCnt = 1 To srcSlide.Shapes.Count
Set currShape = srcSlide.Shapes(shapeCnt)
If (currShape.HasTextFrame = msoTrue) Then
Set currTextFrame = currShape.TextFrame
With currTextFrame
If (.HasText) Then
fontSize = .TextRange.Font.Size
MsgBox "Shape " & shapeCnt & ". Text is [" &
..TextRange.Text & "]." & vbCrLf & _
"Font size " & fontSize
End If
End If
End With
End If
Next shapeCnt
Next cnt ' end for
End With ' end with srcPres

srcPres.Close
ppApp.Quit
Set ppApp = Nothing
Beep
End Sub
 
I think I may have found my answer. The TextRange object has a Runs()
method that allows me to get the ranges of the text with different font
characterstics. Off to test.
 
Back
Top