vba与带圈字符（VBA给字符加圈）

wjhere

最近学习了 水清山兄 关于WORD在方面域应用资料http://club.excelhome.net/viewth ... p;extra=&page=1 ，收获很大。尝试学习写一写代码。想到了以前讨论过的关于给字符加圈，11-100的带圈序号等话题，就想通过vba+域代码。来试一试，写完之后，搜索了一下，守柔版主的方法更好，域代码更简单http://club.excelhome.net/viewth ... D=250325&skin=1
http://club.excelhome.net/viewthread.php?tid=117000
就“拿来”用一下。反正为了方便大家，所以请原谅。
请高手指点，让代码效率更高。批量加圈的时候代码执行较慢所以请不要选中太多内容。默认按词语加圈，如果需要按字符加圈，也请大家根据自己需要修改。

Sub myModifyEnclosure(myR As Range, Optional iFontName As String = "宋体")
'给字符加上圈
'实质就是加上一个Eq域，核心域代码为 eq \o\ac(1,\s\do4(○))
'这是我学习eq后的一个简单组合
'比word自身的域代码（eq \o\ac(○,一)）多了调节上下的部分\s\do4
'可以支持最多四个字符（数字）
'并且通过代码来智能判断字符，来调节字符字号，并修改字体和偏移量，以期达到最佳效果。
Dim myStart As Long
Dim L As Byte
Dim myFontSize As Single
Dim myField As Field
Dim strW As String, strCode As String

If myR.Words.Count > 1 Then Exit Sub

strW = Trim(myR.Text)

L = Len(strW)
If L > 4 Or L = 0 Then Exit Sub
If Asc(strW) = 13 Then Exit Sub
'确定数字字号
Select Case L
    Case 1
    myFontSize = 15
    Case 2
    myFontSize = 12
    Case 3
    myFontSize = 9
    Case 4
    myFontSize = 6.5
End Select
Set myField = myR.Fields.Add(Range:=myR, Type:=wdFieldEmpty, _
               PreserveFormatting:=False)
   myField.ShowCodes = False
    If Asc(strW) < 0 Then '汉字
    strCode = "eq \o\ac(" & strW & ",\s\do3(○))"
    ElseIf Len(strW) > 2 Then '两个以上字符
    strCode = "eq \o\ac(" & strW & ",\s\do5(○))"
    Else
    strCode = "eq \o\ac(" & strW & ",\s\do4(○))"
    End If
    myField.Code.Text = strCode
    myStart = myField.Code.Start + 9
'字符设置
With ActiveDocument.Range(myStart, myStart + L).Font
.Name = iFontName '字体，默认为宋体
.Size = myFontSize '字号
End With
'外圈字号
ActiveDocument.Range(myStart + L + 8, myStart + L + 9).Font.Size = 22

End Sub
Sub myModifyEnclosure2(myR As Range, Optional iFontName As String = "宋体")
'下面的代码参守柔版主的代码，这个方法比较简单
'核心域代码为eq \o(22,○)但是要设置字体的位置
'http://club.excelhome.net/viewthread.php?tid=55346&replyID=250325&skin=1
'http://club.excelhome.net/viewthread.php?tid=117000
Dim myStart As Long
Dim L As Byte
Dim myFontSize As Single
Dim myField As Field
Dim strW As String, strCode As String

If myR.Words.Count > 1 Then Exit Sub

strW = Trim(myR.Text)

L = Len(strW)
If L > 4 Or L = 0 Then Exit Sub
If Asc(strW) = 13 Then Exit Sub
'确定数字字号
Select Case L
    Case 1
    myFontSize = 15
    Case 2
    myFontSize = 12
    Case 3
    myFontSize = 9
    Case 4
    myFontSize = 6.5
End Select
Set myField = myR.Fields.Add(Range:=myR, Type:=wdFieldEmpty, _
               PreserveFormatting:=False)
   myField.ShowCodes = False

    strCode = "eq \o(" & strW & ",○)"
    myField.Code.Text = strCode
    myStart = myField.Code.Start + 6
'字符设置
With ActiveDocument.Range(myStart, myStart + L).Font
.Name = iFontName '字体，默认为宋体
.Size = myFontSize '字号
End With
'外圈字号
With ActiveDocument.Range(myStart + L + 1, myStart + L + 2).Font
.Size = 22
.Position = -Len(strW) - 2 '关键步骤
End With
End Sub
下面是调用例子，加圈内容默认被设置为宋体，可以修改字体。
Sub test()
'批量给选定内容加上圈,速度可能会很慢，所以一次不要太多
Dim mySel As Range
Dim myWord As Range
Dim T As Long, I As Long
Set mySel = Word.Selection.Range
T = mySel.Words.Count
For I = T To 1 Step -1
Set myWord = mySel.Words(I)
myModifyEnclosure2 myWord, "黑体"
Next
End Sub
Sub 批量2()
'批量给选定内容加上圈,速度可能会很慢，所以一次不要太多
Dim mySel As Range
Dim myWord As Range
Dim T As Long, I As Long
Set mySel = Word.Selection.Range
T = mySel.Words.Count
For I = T To 1 Step -1
Set myWord = mySel.Words(I)
myModifyEnclosure myWord, "黑体"
Next
End Sub
Sub test1()
'给光标处词语加圈
myModifyEnclosure Word.Selection.Words(1), "楷体_GB2312"
End Sub
Sub test2()
'给光标处词语加圈
myModifyEnclosure2 Word.Selection.Words(1), "楷体_GB2312"
End Sub

tangqingfu

谢谢wjhere兄的分享，收藏学习！
好像还不能支持字号的变化，如果为字符加圈后，再对其字号进行重新设置，加圈字符不能等缩放，圈会移位。不知能否增加适应字号变化的情况？

cxffxc

对于这个问题，我是这样解决的：域+图文集

wjhere

原帖由 cxffxc 于 2009-9-17 07:58 发表
对于这个问题，我是这样解决的：域+图文集

能否详细说一说？

wjhere

原帖由 tangqingfu 于 2009-9-17 06:59 发表
谢谢wjhere兄的分享，收藏学习！
好像还不能支持字号的变化，如果为字符加圈后，再对其字号进行重新设置，加圈字符不能等缩放，圈会移位。不知能否增加适应字号变化的情况？

特殊情况就自己调整，如果是普遍情况，能否具体说一说。

tangqingfu

我的意思是运行宏后,代码批量为字符加上圈,以一楼的附件为例,如果我们更改字符的字号,加的圈不能随字符的大小变化而变化。
不知能否做到加的圈能随字符的大小变化而变化？

wjhere

以修改myModifyEnclosure2为例，可以在下面的代码中修改圆圈的字体大小，和位置。当然也可以修改颜色等信息。如果圈内字体和圆圈字体的大小存在对应关系就可以编程解决。现在采用的是通过缩小圈内的字体来适应圆圈，达到圆圈大小的统一。
With ActiveDocument.Range(myStart + L + 1, myStart + L + 2).Font
.Size = 22
.Position = -Len(strW) - 2 '关键步骤
End With

chuhaiou

太强大了！

linyancheng

字體大小是不是以比例縮小方式會比較好？如此可適應各種字體大小。
垂直對齊是不是以段落格式置中對齊比較好？如此可適應各種字體大小。

底下是我錄製拼湊及部分修改的代碼，任何字體大小皆適用：

    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="EQ \O\AC(,)"
    Selection.Delete Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, _
        PreserveFormatting:=False
    Selection.TypeText Text:="SEQ 阿圓單  \# 0"
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 2 / 3 '字體大小以比例縮小方式
    Selection.MoveRight Unit:=wdCharacter, Count:=3
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter '垂直對齊以段落格式置中對齊
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Fields.ToggleShowCodes
    Selection.Fields.Update
    Selection.MoveRight Unit:=wdCharacter, Count:=1

linyancheng

底下也是我未學VBA時，錄製拼湊修改的代碼，有些冗長，需要的可自行優化代碼，並分享給大家。

這是針對選擇字元加圓圈的代碼，字元有分個數，程序不同，要自行選擇適當的程序。

Sub 圓圈外加單數字()
'
' 圓圈外加單數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 5 / 6
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加雙數字()
'
' 圓圈外加雙數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 2 / 3
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加雙1數字()
'
' 圓圈外加雙1數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 2 / 3
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加3數字()
'
' 圓圈外加3數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加31數字()
'
' 圓圈外加31數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加4數字()
'
' 圓圈外加4數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=4, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    Selection.Font.Scaling = 70
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加41數字()
'
' 圓圈外加41數字 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    Selection.Font.Scaling = 70
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加單中文()
'
' 圓圈外加單中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 7 / 12
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加單3中文()
'
' 圓圈外加單3中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加雙中文()
'
' 圓圈外加雙中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=2, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    Selection.Font.Scaling = 70
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加雙1中文()
'
' 圓圈外加雙1中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 1 / 2
    Selection.Font.Scaling = 70
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加3中文()
'
' 圓圈外加3中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 4 / 9
    Selection.Font.Scaling = 50
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub
Sub 圓圈外加3長中文()
'
' 圓圈外加3中文 巨集
' 巨集錄製於 2007/10/2，錄製者 Pan
'
    Selection.Cut
    Selection.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:= _
        "EQ \O\AC(,)", PreserveFormatting:=False
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    With ActiveWindow
        With .View
            .ShowFieldCodes = False
        End With
    End With
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
    Selection.MoveLeft Unit:=wdCharacter, Count:=1
    Selection.TypeBackspace
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.TypeText Text:="○"
    Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
    Selection.Font.Scaling = 200
    Selection.MoveRight Unit:=wdCharacter, Count:=2
    Selection.Paste
    Selection.MoveLeft Unit:=wdCharacter, Count:=3, Extend:=wdExtend
    Selection.Font.Size = Selection.Font.Size * 4 / 9
    With Selection.ParagraphFormat
        .BaseLineAlignment = wdBaselineAlignCenter
    End With
    Selection.MoveLeft Unit:=wdCharacter, Count:=2
    Selection.Fields.ToggleShowCodes
    Selection.MoveRight Unit:=wdCharacter, Count:=1
End Sub