Option Explicit
Function CheckMinFontSize(objPresentation As Presentation) As Boolean
Dim objSlide As Slide
Dim objShape As Shape
CheckMinFontSize = True
For Each objSlide In objPresentation.Slides
objSlide.Select
objSlide.Shapes.SelectAll
For Each objShape In Windows(1).Selection.ShapeRange
If objShape.Type = msoPlaceholder Then
If objShape.TextFrame.TextRange.Font.Size < 14 Then
CheckMinFontSize = False
Exit Function
End If
End If
Next objShape
Next objSlide
End Function
Sub Font_Check()
If CheckMinFontSize(ActivePresentation) = False Then
Debug.Print "too small."
End If
End Sub
|