Sub 修复文本溢出()
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
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