CODEWITHSUNDEEP
vbams-word
ateeq officeuse
ateeq officeuse

Reputation: 11

How to Insert Shape at cursor position in MSWORD using VBA

I want to insert a shape in Word above the picture where ever user clicks.

I have written the program below, but sometimes it is placing the rectangle incorrectly and inserting it twice: once where I need it and again somewhere else.

Why is the Shape being inserted twice?

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

Upvotes: 1

Views: 2426

Answers (1)

Cindy Meister
Cindy Meister

Reputation: 25663

The reason the code is firing more than once is because of the use of the Select method. Code changing the selection is the same as the user doing so. The way to avoid this is to work directly with the Word objects.

The code below illustrates this in the procedure CurosrXY_Pixels. A Shape object is declared, then the newly inserted drawing object assigned to it. This then used for setting the formatting and text, in the With block.

Notice I've also passed the Selection object from the event to this procedure, as well as to the two that calculate the co-ordinates. Since, conceivably, the user could click again before the macro finishes, it's important to pass along the original Selection. (That the original code was not doing so probably contributed to the "randomness" of where things were being created since the code, itself, was changing the selection.)

The code line in the app_WindowSelectionChange event to call the other procedures: 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

Upvotes: 1

Related Questions