Private Sub CommandButton1_Click()
Dim p As Page
Dim pcount As Integer
Dim sr As ShapeRange
pcount = ActiveDocument.Pages.Count
Dim s As Shape
Dim z As Long
Dim oldz As Long
Dim szzz As TextRange
Dim f As Integer
For i = 1 To pcount
ActiveDocument.Pages(i).Activate
Set sr = ActivePage.Shapes.FindShapes()
For Each s In sr.Shapes
If (s.Type = cdrTextShape) Then
z = 0
oldz = 0
z = s.Text.Find("〇", False, 1)
If (z >= 1) Then
For f = 1 To s.Text.Story.Length
Set szzz = s.Text.Range(f - 1, f)
If (szzz.Text = "〇") Then szzz.Font = "楷体"
Next
End If
End If
Next
Next
End Sub