Macro to insert shape

radioMic · #1 03-11-2022, 02:34 PM

I have played with VBA in Excel and, got alit okay with it but knowing what I don’t know, I know that I need to ask for help.

I have skulked around the interwebs and found how to insert a shape in the current document -

ActiveDocument.Shapes.AddShape msoFreeForm Left, Top, 300, 30

What I would like to ask is how to adjust the code to insert the shape at the current cursor location within the document? Thinking that would eliminate the Left, Top coordinates ( ! yay ).

Now for the fun stuff... how do I change the fill and line colors of the shape?

And here's the tricky stuff... how do I add a 2x1 table inside of the shape just inserted, adjust the width of and vertically center align ( text for ) the first cell.

Probably one of the more odd asks, but want to say thanks in advance for the help.

macropod · #2 03-11-2022, 04:18 PM

Why are you trying to insert a table into a shape, instead of simply inserting the table at the required position?

radioMic · #3 03-12-2022, 04:41 PM

Well, if I could figure out how to insert an image intone response, you could better see what I am looking to accomplish. Basically, it's a type of call out for tips, notes, info or warnings where the single word in the first column is centered horizontally & vertically, while the content in the second column can be one to three sentences long.

In short, it makes it easier to format the callout no matter its width so the alert looks nice.

macropod · #4 03-13-2022, 05:03 PM

Here is some code to get you started:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Shp As Shape, Rng As Range, Hght As Single, Wdth As Single
Hght = InchesToPoints(0.5):  Wdth = InchesToPoints(2)
With ActiveDocument
  Set Rng = Selection.Range.Characters.First
  Set Shp = .Shapes.AddShape(Type:=msoShapeRectangularCallout, _
    Left:=Rng.Information(wdHorizontalPositionRelativeToPage), _
    Top:=Rng.Information(wdVerticalPositionRelativeToPage) - Hght, _
    Width:=Wdth, Height:=Hght, Anchor:=Rng)
  .Tables.Add Range:=Shp.TextFrame.TextRange, Numrows:=1, numcolumns:=2
  Shp.TextFrame.TextRange.Characters.Last.Font.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

radioMic · #5 03-15-2022, 11:16 AM

Looks interesting! Will give it the customary test drive and look forward to it working.

Thanks.

radioMic · #6 03-22-2022, 10:33 AM

Nicely done sir! It's the start I was looking for.

Now the 2nd half of fun starts skulking around the internet to see what I can find on formatting the shape that will compliment your code.

Much thanks.

radioMic · #7 03-23-2022, 07:02 AM

Applied the code tweak and worked nicely.

Did find most of the formatting calls, lo, but two...

How do I format cells(1, 1) to be center left aligned and add text to that cell?

Otherwise, turned out rather nicely.

Thanks.

macropod · #8 03-23-2022, 01:47 PM

For example:

Code:

Sub Demo()
Application.ScreenUpdating = False
Dim Shp As Shape, Rng As Range, Tbl As Table, Hght As Single, Wdth As Single
Hght = InchesToPoints(0.5):  Wdth = InchesToPoints(2)
With ActiveDocument
  Set Rng = Selection.Range.Characters.First
  Set Shp = .Shapes.AddShape(Type:=msoShapeRectangularCallout, _
    Left:=Rng.Information(wdHorizontalPositionRelativeToPage), _
    Top:=Rng.Information(wdVerticalPositionRelativeToPage) - Hght, _
    Width:=Wdth, Height:=Hght, Anchor:=Rng)
  Set Tbl = .Tables.Add(Range:=Shp.TextFrame.TextRange, Numrows:=1, NumColumns:=2)
  With Tbl.Cell(1,1).Range
    .Text = "Some text"
    .ParagraphFormat.Alignment = wdAlignParagraphLeft
  End With
  Shp.TextFrame.TextRange.Characters.Last.Font.Hidden = True
End With
Application.ScreenUpdating = True
End Sub

Similar Threads
Thread	Thread Starter	Forum	Replies	Last Post
Word 2016 how to insert a text shape into a word doc ?	zillah	Word	2	11-14-2019 03:27 AM
Add a macro to a shape	guest_gast	Word VBA	12	07-07-2018 02:20 AM
Assign Macro to Shape in Word 2013	tunes10590	Word VBA	8	01-29-2015 06:26 AM
Easy means to access/insert frequently used Shape	rdy4trvl	Drawing and Graphics	5	09-16-2012 08:12 AM
Run Macro & Activate shape	ibrahimaa	Excel Programming	1	01-21-2012 02:14 AM