如何使用VBA在MSWORD中的光标位置插入形状

Question

我想在用户单击的图片上方插入一个形状。

我已经在下面编写了程序，但有时它会错误地放置矩形并插入两次：一次是在我需要的地方，另一次是在其他地方。

为什么形状入两次？

Private WithEvents app As Word.Application
Private Sub app_WindowSelectionChange(ByVal Sel As Selection)
Cancel = True
Call CurosrXY_Pixels
End SuB
Sub CurosrXY_Pixels()
ActiveDocument.Shapes.AddShape(msoShapeRectangle, fcnXCoord, fcnYCoord, 20#, 16#).Select
With Selection
.ShapeRange.TextFrame.TextRange.Select
.Collapse
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = False
.Paragraphs.FirstLineIndent = 0
.Paragraphs.RightIndent = -10
.Paragraphs.LeftIndent = -10
.Paragraphs.Alignment = wdAlignParagraphCenter
.TypeText Text:=11
.ShapeRange.LockAspectRatio = msoCTrue
End With
End Sub
Function fcnXCoord() As Double
fcnXCoord = Selection.Information(wdHorizontalPositionRelativeToPage)
End Function
Function fcnYCoord() As Double
fcnYCoord = Selection.Information(wdVerticalPositionRelativeToPage)
End Function

Answer 1

代码多次触发的原因是因为使用了Select方法。更改选择的代码与用户更改选择的代码相同。避免这种情况的方法是直接使用 Word 对象。

下面的代码在过程CurosrXY_Pixels中对此进行了说明。声明一个Shape对象，然后声明分配给它的新插入的图形对象。然后用于在With块中设置格式和文本。

请注意，我还将事件中的Selection对象传递给了此过程，以及传递给计算坐标的两个对象。可以想象，由于用户可以在宏完成之前再次单击，因此传递原始Selection非常重要。(原始代码没有这样做，这可能导致创建位置的"随机性"，因为代码本身正在改变选择。

app_WindowSelectionChange事件中的代码行调用其他过程：CurosrXY_Pixels Sel

Sub CurosrXY_Pixels(Sel As Word.Selection)
Dim shp As Word.Shape
Set shp = ActiveDocument.Shapes.AddShape(msoShapeRectangle, fcnXCoord(Sel), fcnYCoord(Sel), 20#, 16#, Sel.Range)
With shp.TextFrame.TextRange
.Font.Name = "Arial"
.Font.Size = 7
.Font.Bold = False
.Paragraphs.FirstLineIndent = 0
.Paragraphs.RightIndent = -10
.Paragraphs.LeftIndent = -10
.Paragraphs.Alignment = wdAlignParagraphCenter
.Text = 11
End With
shp.LockAspectRatio = msoCTrue
End Sub
Function fcnXCoord(Sel As Word.Selection) As Double
fcnXCoord = Sel.Information(wdHorizontalPositionRelativeToPage)
End Function
Function fcnYCoord(Sel As Word.Selection) As Double
fcnYCoord = Sel.Information(wdVerticalPositionRelativeToPage)
End Function