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

我想在图片上方的Word中插入一个形状，以便用户单击

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

为什么形状要插入两次

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

---

代码多次触发的原因是使用了

Select

方法。更改选择的代码与用户更改选择的代码相同。避免这种情况的方法是直接使用单词对象

下面的代码在过程

CurosrXY\u Pixels

中对此进行了说明。声明

形状

对象，然后将新插入的图形对象指定给该对象。然后，这将用于设置

With

块中的格式和文本

注意，我还将

选择

对象从事件传递到此过程，以及两个计算坐标的对象。可以想象，由于用户可以在宏完成之前再次单击，因此传递原始的

选择非常重要。（原始代码没有这样做，可能是由于代码本身正在更改选择，导致创建内容的位置“随机性”的原因。）

app\u WindowSelectionChange
事件中的代码行调用其他过程：
CurosrXY\u像素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

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

下面的代码在过程
CurosrXY\u Pixels
中对此进行了说明。声明
形状
对象，然后将新插入的图形对象指定给该对象。然后，这将用于设置
With
块中的格式和文本

注意，我还将
选择
对象从事件传递到此过程，以及两个计算坐标的对象。可以想象，由于用户可以在宏完成之前再次单击，因此传递原始的
选择非常重要。（原始代码没有这样做，可能是由于代码本身正在更改选择，导致创建内容的位置“随机性”的原因。）

app\u WindowSelectionChange
事件中的代码行调用其他过程：
CurosrXY\u像素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

请注意，根据网站指南，每个问题只允许一个问题（请参阅）。在我的编辑中，我两次选择了关于代码执行的问题，因为以我在回答中描述的方式解决这个问题也可能有助于解决另一个问题。如果安置问题仍未解决，请在一个新问题中发布该问题，并提供有关定位错误的更多信息：描述您的期望以及结果如何不同。请注意，根据网站指南，每个问题只允许一个问题（请参阅）。在我的编辑中，我两次选择了关于代码执行的问题，因为以我在回答中描述的方式解决这个问题也可能有助于解决另一个问题。如果安置问题仍未解决，请在一个新问题中发布更多关于定位错误的信息：描述您的期望以及结果如何不同。您是对的，但我已经尝试过，当我第一次单击左键时，它在错误的一侧插入形状，当我再次单击时，在光标位置创建了导致双面创建的形状。你能帮我解决这个问题吗？@ateeqofficeuse你的评论不清楚。这个答案说明了代码执行多次的原因。如果该问题已解决，则应将其指定为答案（单击其旁边的复选标记）。然后针对不同的问题问一个新问题（显然是位置）。确保非常彻底和清楚地解释问题，包括重现问题的代码。请注意，Stack Overflow不是一个“论坛”-在您的每个问题都得到回答之前，我们不会进行讨论：每个问题都需要一个新问题。您可能想访问。您是对的，但我尝试过，当我第一次单击“左键单击”时，它在错误的一侧插入形状，当我再次单击时，在光标位置创建，从而导致双面创建。你能帮我解决这个问题吗？@ateeqofficeuse你的评论不清楚。这个答案说明了代码执行多次的原因。如果该问题已解决，则应将其指定为答案（单击其旁边的复选标记）。然后针对不同的问题问一个新问题（显然是位置）。确保非常彻底和清楚地解释问题，包括重现问题的代码。请注意，Stack Overflow不是一个“论坛”-在您的每个问题都得到回答之前，我们不会进行讨论：每个问题都需要一个新问题。你可能想去参观博物馆。