加圈文本

在整理书籍的过程中，会遇到一些图形。图形中会有一些带圈的图形，如①②③等等。当然，如果是在10（含）以内，在word中可以通过插入编号进行录入；如果在20（含）以内，有些输入法也可以输入（⑳）。但如果是其它的数字，就无能力了。

为解决这个问题，本人写了个Word2007的vba，代码如下：

Private Sub GenCircle(value As String)

    Me.TextBoxTest.Text = Me.TextBoxTest.Text & value & ","
    
    Dim size As Integer
    size = Me.TextBoxSize.value
    
    Dim startLeft As Integer
    Dim startTop As Integer
    Me.Shapes(1).RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    startLeft = Me.Shapes(1).left
    Me.Shapes(1).RelativeVerticalPosition = wdRelativeHorizontalPositionPage
    startTop = Me.Shapes(1).top + 10
    
    Dim fontSize As Integer
    Dim spacing As Integer
    fontSize = Me.TextBoxFontSize.value
    spacing = Me.TextBoxSpacing.value
    
    Dim curLine As Integer
    Dim curColumn As Integer
    curLine = Fix((Me.Shapes.Count - 1) / 5)
    curColumn = (Me.Shapes.Count - 1) Mod 5
    
    Dim left As Integer
    Dim top As Integer
    left = startLeft + curColumn * size + spacing * curColumn
    top = startTop + curLine * size + spacing * curLine
    
    Dim shape As shape
    Set shape = Me.Shapes.AddShape(msoShapeOval, left, top, size, size)
    shape.TextFrame.TextRange.Text = value
    shape.TextFrame.TextRange.Font.size = fontSize
    shape.TextFrame.TextRange.ParagraphFormat.Alignment = wdAlignParagraphCenter
    shape.TextFrame.VerticalAnchor = msoAnchorMiddle
End Sub

Private Sub GenCircles(ByRef values() As String)

    Dim i As Integer
    For i = LBound(values) To UBound(values)
        GenCircle values(i)
    Next

End Sub
Private Sub RemoveShapes()
    Dim i As Integer
    If (Me.Shapes.Count > 1) Then
        For i = Me.Shapes.Count To 2 Step -1
            Me.Shapes(i).Select
            Call Selection.ShapeRange.Delete
        Next
    End If

End Sub

Private Sub CommandButtonDo_Click()
    Call RemoveShapes
    Me.TextBoxTest.Text = ""
    
    Dim textNumbers As String
    textNumbers = Me.TextBoxNumbers.Text
    If textNumbers <> "" Then
        Dim textNumberss() As String
        textNumberss = Split(textNumbers, ",")
        
        Dim i As Integer
        For i = LBound(textNumberss) To UBound(textNumberss)
            If InStr(textNumberss(i), "-") > 0 Then
                Dim fromTo() As String
                fromTo = Split(textNumberss(i), "-")
                Dim j As Integer
                For j = CLng(fromTo(0)) To CLng(fromTo(1))
                    GenCircle CStr(j)
                Next
            Else
               GenCircle textNumberss(i)
            End If
        Next
        
    End If

    Dim textChars As String
    textChars = Me.TextBoxChars.Text
    If textChars <> "" Then
        Dim s() As String
        s = Split(textChars, ",")
        GenCircles s
    End If
    
    MsgBox "完成！"
    
End Sub

有点乱，有兴趣者自己改善吧。

上面的代码ctrl+v到Word的代码中并不能直接运行，还需要插入几个控件和一个占位图形，具体的就不说了，参照代码或完整的docm文件即可。
完整的docm文件在本人的资源中。