VBA code to select the first shape in the current active paragraph in MS Word 2013

[john.s2011]

hi friends.
I am new to VBA

Word 2013, I need a simple VBA code in my macro which selects the first shape that exists in the current active paragraph.
Note: the shape that I need the code to select is a custom shape that I have created and saved as an autotext in BuildingBlockEntries. The code I use to insert my shape is :
Application.Templates( _
"C:\Users\Administrator\AppData\Roaming\Microsoft\Templates\Normal.dotm") _
.BuildingBlockEntries("_red_box").insert where:=Selection.Range, RichText:=TrueThe purpose of selecting the shape is to paste clipboard contents into it via the following code:
ActiveDocument.ActiveWindow.Selection.Paste) What would be the VBA code to select the shape?

thanks in advanced

[macropod]

This is a continutation of posts for which you have already received extensive help at: https://social.msdn.microsoft.com/Forums/office/en-US/5b7af71b-bb47-4adb-a905-1869246be06f/need-simple-code-to-select-a-custom-shape-which-we-have-inserted-just-right-now?forum=worddev and: https://social.msdn.microsoft.com/Forums/office/en-US/c350e199-feae-4c53-a3ad-33b35c52258b/urgent-need-a-vba-code-to-dynamically-increase-or-decrease-the-width-of-the-shape-according-to-the?forum=worddev#f4811129-4850-4adf-abac-54739122e402
In effect, you are cross-posting and should provide both the context of your request and links to the other threads. For cross-posting etiquette, please read: http://www.excelguru.ca/content.php?184

[john.s2011]

hi macropod.
i have been annoyed on this question. you don't believe but i have asked that from lots of developers but nobody knows the answer.

i am close to answer. i have a code to selet current paragraph which cursor is located:

Dim Rng As Range
With ActiveDocument
Set Rng = .GoTo(What:=wdGoToBookmark, Name:="\para")
Rng.ShapeRange(1).Select
Rng.Paste
End With

but the problem is in the 3 underlined lines.
in fact Rng.ShapeRange(1).Select doesn't select my shape (the first shape in the paragraph).

please save me from such hell. what would be that one line code ? ( which selects the first shape in the current paragraph)

????????????????? i think nobody knows except you

[macropod]

To start with, you don't need to Select anything to work with it. And, since you don't say what you actually want to do with the shape, it's a bit hard to advise on the best way of going about that task. In the first post in the first link above, you say

i need to know, when i just insert a custom shape in my word document, via what code i can select this shape which i have just inserted?
but your post also shows three shapes. So, how are you inserting these shapes? More importantly, what are you trying to achieve?

At https://social.msdn.microsoft.com/Forums/office/en-US/c350e199-feae-4c53-a3ad-33b35c52258b/urgent-need-a-vba-code-to-dynamically-increase-or-decrease-the-width-of-the-shape-according-to-the?forum=worddev#f4811129-4850-4adf-abac-54739122e402 you have the following code:
' insert the _red_box shape in the cutted text block location:
Application.Templates( _
"C:\Users\Administrator\AppData\Roaming\Microsoft\Templates\Normal.dotm") _
.BuildingBlockEntries("_red_box").insert where:=Selection.Range, RichText:=True

If that's the shape you want to work with and you want to past the clipboard content into it, what you need is code like:

Dim StrTmplt As String, Shp As Shape
StrTmplt = "C:\Users\" & Environ("UserName") & _
"\AppData\Roaming\Microsoft\Templates\Normal.dotm"
'Code for cutting, etc. goes here:
'...
' insert the _red_box shape in the cutted text block location:
Set Shp = Application.Templates(StrTmplt) _
.BuildingBlockEntries("_red_box").Insert _
(where:=Selection.Range, RichText:=True)
With Shp
.TextFrame.TextRange.Paste
End With

On the whole, though, your code is a mess. As I said, though, if you tell us exactly what it is you're trying to achieve, both we and you could spend less time working on it. So far, all anyone other than you gets to do is work on it piecemeal, with no understanding of the larger context.

[john.s2011]

ok. Let me again clarify it for you. i have posed my scenario lots of time. but no matter if i finally get the solution.

imagine i am working on an article so i am preparing a word document which will have for example 3 pages.
anywhere in this document, i decide to make one of the line to be appeared as title (heading) of the issue.
for example, i am writing the following document about cloud computing:

cloud computing

Public Cloud:
Collection of network resources which is owned by Cloud service providers (CSPs) & is publicly available to all organizations & companies.
• Needs more budget
• Has fewer security

Private cloud:
Collection of resources which belongs to one organization & is located outside organization in a private network & is available to this organization only.

-----------------------------

here i decide that this 3 blocks which have underline, be as title in this way:
i need when i click anywhere in each of these 3 lines, & then run my Macro, that macro perform following steps for me:
1- it first must select the entire line for example this line: Public Cloud:
2- it cuts the entire words in the line (or entire line )
3- it inserts my custom shape called "_Red_Box" which i had created earlier & i had saved it as an Autotext in buildingblock entries.
4-then it must select this inserted custom shape
5- finally it must paste the clipboard contents (cutted text) into this shape, so that instead of this line " Public Cloud: " , we see a red box which contains this text: "public cloud" & now it is viewed as title.
i need a code that performs steps 4 & 5.


note that i continue & now i decide to make this line Private cloud: as title, so when i put cursor on this line "Private cloud:", & then i run my macro,i need the above 5 steps be done as well.

and in other pages, there will be some lines which i want to make them be cutted & be pasted inside my custom "_red_box"

i have shown my desired result in this figure:


12552

[macropod]

Try the following. macro.

Sub Demo()
Application.ScreenUpdating = False
Dim StrTmplt As String, Rng As Range, StrTxt As String
StrTmplt = "C:\Users\" & Environ("UserName") & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
Set Rng = Selection.Paragraphs(1).Range
With Rng
.End = .End - 1
StrTxt = .Text
.Text = ""
End With
Application.Templates(StrTmplt).BuildingBlockEntries("_red_box").Insert where:=Rng, RichText:=True
With Rng.Paragraphs(1).Range.ShapeRange(1).TextFrame
.WordWrap = False
With .TextRange
.Text = StrTxt
With .Font
.Size = 20
.Bold = True
.ColorIndex = wdRed
End With
End With
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub
You'll note that I've added some code to reformat the text & resize the autoshape, as per the discussion at: https://social.msdn.microsoft.com/Forums/office/en-US/c350e199-feae-4c53-a3ad-33b35c52258b/urgent-need-a-vba-code-to-dynamically-increase-or-decrease-the-width-of-the-shape-according-to-the?forum=worddev

FWIW, the above macro doesn't use any of your steps 1, 2, 4 or 5. As I said, you needed to describe what you're trying to achieve, but what you provided was a description of how. The what is to replace the text of the current paragraph with an autoshape (previously saved as an Autotext in buildingblock entry named "_Red_Box") containing that text. The foregoing macro does the whole lot without selecting anything and without any cutting & pasting. Instead, it populates a string variable with the text, which it then deletes, before inserting your autoshape and adding the text to it. All you need do is to make sure the insertion point is within the paragraph you want to transform. Mind you, if you were content to have the paragraph bounded by a red box that was the full margin width, none of the foregoing process would be required, all you'd ever have needed is an appropriate Style definition, as per my post of 6 November in the above thread. Indeed, you may yet find yourself forced to take that approach if you end up with reformatted, autotext-boxed headings that don't fit within the page margins.

[john.s2011]

hello Deeeeeeeeeaaaaaarrr Macropod

eventually you saved me.
thank you very very very muuuuuuuuchhhhh. you really saved me helped me. i don't know how to thank you.
it was the exact code which i needed & after one month struggling with VBA, finally you delivered me the exact code which i needed.
i had asked it from many developers but they were unable to create that & they told me that via VBA it is not possible ....

really Appreciate your knowledge, you are a real specialist.
i don't know how to show my happiness.

best regards

[john.s2011]

dear macropod,
only one small point remains.

when i run your macro, a very small problem exist. the red box is pasted on the other lines, which i have shown it in this figure:

before running final macro:

12556

after running macro:

12557

to resolve this problem, i added this lines at the beginning of your macro & it fixed the problem:

Sub Demo ()


Selection.EndKey Unit:=wdLine
Selection.GoTo What:=wdGoToLine, Which:=wdGoToNext, Count:=1
Selection.TypeParagraph
Selection.TypeParagraph
Selection.GoTo What:=wdGoToLine, Which:=wdGoToPrevious, Count:=3


Application.ScreenUpdating = False
' & the rest of the codes...........

now the result is :

12558
:-)

is my solution ok ? or there is more reasonable & more correct way?

many thanks

[macropod]

The problem there is that you haven't formatted your textbox appropriately. You should format it with 'Top & Bottom' wrapping. Although it could be reformatted in code every time (as shown below), you'd do better to do so with the actual textbox - and both lock its anchor and set its relative vertical positioning to how it should appear in that arrangement (although that too can be done in code). Similarly, if you formatted it with the text format you want (20pt, bold, red), you wouldn't need that in the code, either.

Sub Demo()
Application.ScreenUpdating = False
Dim StrTmplt As String, Rng As Range, StrTxt As String
StrTmplt = "C:\Users\" & Environ("UserName") & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
Set Rng = Selection.Paragraphs(1).Range
With Rng
.End = .End - 1
StrTxt = .Text
.Text = ""
End With
Application.Templates(StrTmplt).BuildingBlockEntries("_red_box").Insert where:=Rng, RichText:=True
With Rng.Paragraphs(1).Range.ShapeRange(1)
.WrapFormat.Type = wdWrapTopBottom
With .TextFrame
.WordWrap = False
With .TextRange
.Text = StrTxt
With .Font
.Size = 20
.Bold = True
.ColorIndex = wdRed
End With
End With
End With
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub

[john.s2011]

The problem there is that you haven't formatted your textbox appropriately. You should format it with 'Top & Bottom' wrapping. Although it could be reformatted in code every time (as shown below), you'd do better to do so with the actual textbox - and both lock its anchor and set its relative vertical positioning to how it should appear in that arrangement (although that too can be done in code). Similarly, if you formatted it with the text format you want (20pt, bold, red), you wouldn't need that in the code, either.

Sub Demo()
Application.ScreenUpdating = False
Dim StrTmplt As String, Rng As Range, StrTxt As String
StrTmplt = "C:\Users\" & Environ("UserName") & "\AppData\Roaming\Microsoft\Templates\Normal.dotm"
Set Rng = Selection.Paragraphs(1).Range
With Rng
.End = .End - 1
StrTxt = .Text
.Text = ""
End With
Application.Templates(StrTmplt).BuildingBlockEntries("_red_box").Insert where:=Rng, RichText:=True
With Rng.Paragraphs(1).Range.ShapeRange(1)
.WrapFormat.Type = wdWrapTopBottom
With .TextFrame
.WordWrap = False
With .TextRange
.Text = StrTxt
With .Font
.Size = 20
.Bold = True
.ColorIndex = wdRed
End With
End With
End With
End With
Set Rng = Nothing
Application.ScreenUpdating = True
End Sub


---------------------------------------------------------

Paul, that's excellent. exactly what i needed.
you really helped me really. without your solution i had to perform many strange steps to achieve my needs
i don't know how to thank you
i pray for you & i wish you be always healthy & happy in your life.
you are a real developer not those that told me it's impossible in VBA

best regards