请教宏问题。

clm100

请帮助改正下面宏中错误。谢谢 Sub 米字格() ' ' 米字格 Macro ' 宏在 02-6-21 由 aaa 创建 'word to tb 0 Dim plefy As Long Dim ptop As Long Dim ydsize As Long Dim tdspace As Long '文本框边距(默认2磅) tdspace = InputBox("请输入文本框边距", , 2) '本次转换以前图形对象数 Countl = ActiveDocument.Shapes.Count '起点（所迁文字第一个字符相对页面的水平、垂直距离） Pleft = Selection.Information(wdHorizontalPositionRelativeToPage) plop = Selection.Information(wdVerticalPositionRelativeToPage) '所选文字的大小 fSize = Selection.Font.Size '文本框的大小 tdSize = fSize + tdspace * 2 '返回所选文字的字符格式 Set DupFOnt = Selection.Font.Duplicate '返回所选文字的文本（无格式） tStr = Selection.Text '返回所先文字的字符个数 slen = Len(pStr) '删除所选文字 Selection.Delete '逐字填入“米”字格 For i = i To slen '当前要创建文本框的起点（为了简化程序并且从实际出发，没有考虑换行） tdleft = Pleft + tdSize * (i - 1) '创建一个文本框 set tShape = ActiveDocument.Shapes.AddTextbox(msoTextOrientationHorizontal, tbLeft, pTop, tbSize, tbSize) tShape.Name = "TBl" '设置文本框文字 With tShape.TextFrame '向文本区添加一个文字 .TextRange.Text = Mid(pStr, i, 1) '将文本区文字的格式设置成原来所选文字的格式 TextRange.Font = DupFOnt '设置固定行高和具体磅值 .TextRange.ParagraphFormat .LineSpacingRule = wdLineSpaceExactly 'TextRange.ParagraphFormat. LineSpacing = fSize '设置文本框边距 .MarginBottom = tbSpace .MarginLeft = tbSpace .MarginRight = tbSpace .MarginTop = tbSpace End With '画“米”字格的4条线 With ActiveDocument.Shapes .AddLine(tbLeft, ptop, tbLeft + tbSize, ptop + tbSize).Name = "Lin1" .AddLine(tbLeft, ptop, tbLeft + tbSize, tbLeft + tbSize, ptop).Name = "Lin2" .AddLine(tbLeft, ptop + ptop + tbSize / 2, tbLeft + tbSize, ptop + tbSize / 2).Name = "Lin3" .AddLine(tbLeft + tbSize / 2, ptop, tbLeft + tbSize / 2, ptop + tbSize).Name = "Lin4" '组合的“米”字线命名为R1，线型设置为虚线 With .Range(Array("Lin1", "Lin2", "Lin3", "Lin4")).Group .Name = "R1" .Line.DashStyle = msoLineSquareDot End With End With '把文本框和米字线组合 ActiveDocument.Shapes.Range(Array("TB1", "R1")).Group.Select Next i '本次转换以后文本框组合前图表对象数 Count2 = ActiveDocument.Shapes.Count '如果只处理一个文字不用再组合 If Count2 - Count1 > 1 Then '组合生成的所有图形对象并且选中 Do ActiveDocument.Shapes.Range(Array(Count1 + 1, Count1 + 2)).Group.Select '上一语句执行前多一个图形对象（这次的图形对象全部组合成一个了） Loop While Count3 > Count1 + 1 End If '设置成紧密型环绕 Seleion.ShapeRange.WrapFormat.Type = wdWrapTight End Sub