Sub Test() Dim s As Shape ActiveDocument.ReferencePoint = cdrTopLeft For Each s In ActiveDocument.ActivePage.Shapes If s.Type = cdrTextShape Then If s.Text.Type = cdrParagraphText Then If s.Text.Overflow Then AdjustFrame s End If End If Next s End Sub Private Sub AdjustFrame(s As Shape) Dim h As Double h = s.SizeHeight / 10 While s.Text.Overflow s.SizeHeight = s.SizeHeight + h Wend End Sub