Word VBA キャンバス内の図を操作

Sub startMoldShapes()
    Dim itemMax As Long
    Dim itemName As String
    Dim pageName As String
    Dim ans As Boolean

pageName = Selection.ShapeRange(1).Name
ans = MsgBox("OK?", vbYesNo)
If ans = False Then End
itemMax = ActiveDocument.Shapes(pageName).CanvasItems.Count

For i = 1 To itemMax
    itemName = ActiveDocument.Shapes(pageName).CanvasItems(i).Name


    If itemName Like "*Rectangle*" Then
        With ActiveDocument.Shapes(pageName).CanvasItems(i)
            .Width = MillimetersToPoints(30)
            .Height = MillimetersToPoints(10)
            .TextFrame.TextRange.Font.Size = 8
            .TextFrame.HorizontalAnchor = msoAnchorCenter
            .TextFrame.VerticalAnchor = msoAnchorMiddle
            .TextFrame.TextRange.Font.Name = "ＭＳ Ｐゴシック"
            .TextFrame.MarginTop = 0
            .TextFrame.MarginBottom = 0
            .TextFrame.MarginRight = 0
            .TextFrame.MarginLeft = 0
        End With

        ActiveDocument.Shapes(pageName).CanvasItems(i).Select
        With Selection.ParagraphFormat
            .LineSpacingRule = wdLineSpaceExactly
            .LineSpacing = 7
        End With
    End If
Next

End Sub