Finding shapes

[Fuzzhead]

I have the following macro that creates vertical lines and then names each
one. How would I write a macro that would let me scroll down thru my
documents at a later date and find each one, look at it and then ask me to go
to the next one?

Dim lineNew As Shape
Dim i, j
On Error GoTo Endthis
i = Selection.Information(wdVerticalPositionRelativeToPage)
j = InchesToPoints(InputBox("BAR LENGTH {In Inches}:"))
Set lineNew = ActiveDocument.Shapes.AddLine(562, i, 562, j + i)
lineNew.Name = "vline" & idx
idx = idx + 1
Endthis:

 

[periodic]

I recently wrote the following macro to check some shapes in a document

Public Function checkShapes() As Boolean
Selection.HomeKey unit:=wdStory, Extend:=wdMove

Dim picPos As Long
Dim oldPos As Long

checkShapes = False

Dim elm As Shape
Dim elm2 As InlineShape

For Each elm In ActiveDocument.Shapes
MsgBox prompt:="invalidShape! All shapes must be inline shapes"

'next two lines to make word jump here in the document
Selection.Start = elm.Anchor.Start
Selection.EndKey unit:=wdLine, Extend:=wdExtend
Exit Function
Next elm

For Each elm2 In ActiveDocument.InlineShapes
Selection.Start = elm2.Range.Start
Selection.MoveRight unit:=wdCharacter, Extend:=wdExtend

If Not Selection.Style = "Picture" Then
If InStr(1, elm2.Field.Code.Text, "Equation", vbTextCompare) <>
0 Then
If Not Selection.Style = "Caption EQ" Then
MsgBox "Equation has the wrong style, fix this!"
Exit Function
End If
Else
MsgBox "Picture has the wrong style, fix this!"
Exit Function
End If
End If


Dim pageWidth As Long
Dim leftMargin As Long
Dim rightMargin As Long

pageWidth = ActiveDocument.PageSetup.pageWidth
leftMargin = ActiveDocument.PageSetup.leftMargin
rightMargin = ActiveDocument.PageSetup.rightMargin

Dim textWidth As Long

textWidth = pageWidth - leftMargin - rightMargin

If elm2.Width >= textWidth Then
MsgBox prompt:="picture is too wide, fix this!"
Exit Function
End If

Next elm2

checkShapes = True

End Function


Anyway the way I found you made word jump to a shape was by marking it.
Therefore the:
Selection.EndKey unit:=wdLine, Extend:=wdExtend

Then I guess you could just use a MsgBox to say go to the next with a yes
and no button. I wrote this in a macro recently

msgBoxRet = MsgBox(prompt:=msgString, buttons:=vbYesNoCancel)

If msgBoxRet = vbYes Then
Selection.Delete unit:=wdCharacter, count:=1
Selection.Collapse direction:=wdStart
Selection.InsertCrossReference

referenceType:=wdRefTypeNumberedItem, _

referenceKind:=wdNumberRelativeContext, _
referenceItem:=refNum, _
insertAsHyperlink:=True, _
includePosition:=False, _
SeparateNumbers:=False, _
SeparatorString:=" "
ElseIf msgBoxRet = vbCancel Then
Exit Sub
End If

Hope its to some help

 

[Fuzzhead]

periodic,

What you have is over my head. I am not sure how to use what you gave me.

fuzzhead

 

[periodic]

Ok

Had some more tome to check into this now.

First of all you original code wont work. It must look something like this

Sub insertLine()

Dim lineNew As Shape
Dim i As Long
Dim j As Long
Dim idx As Long
idx = ActiveDocument.Variables("idx") + 1
i = Selection.Information(wdVerticalPositionRelativeToPage)
j = InchesToPoints(1)
ActiveDocument.Shapes.AddLine(562, i, 562, j + i).Name = "vline" & idx
ActiveDocument.Variables("idx") = idx
End Sub

So you keep the line numbering variable between the runs of the macro.

Next is the find it macro

Sub findIt()

Selection.HomeKey unit:=wdStory, Extend:=wdMove

Dim elm As Shape

For Each elm In ActiveDocument.Shapes
'Use inStr to check that the shape is a line we added.
If InStr(1, elm.Name, "vline", vbTextCompare) Then
Selection.Collapse direction:=wdCollapseStart
gotoRange rng:=elm.Anchor
elm.Select
MsgBox prompt:="See next"
End If
Next elm
End Sub

Then we need to jump to a range in the document. I have not figured a good
way to do this. I consider this a hack. Anyway someone else might have a
better way to jump to a selected object.

Sub gotoRange(rng As Range)
Selection.Range = rng
Selection.Collapse direction:=wdCollapseStart
Selection.EndKey unit:=wdLine, Extend:=wdExtend
End Sub

you can probably figure out the details of this. This is just a rough and
fast hack to show you the basics of how it can be done.

Hope this is of more help

 

[periodic]

I found a better way to solve the jumping to a range part.

The new findIt macro then looks like this

Sub findIt()

Selection.HomeKey unit:=wdStory, Extend:=wdMove

Dim elm As Shape

For Each elm In ActiveDocument.Shapes
If InStr(1, elm.Name, "vline", vbTextCompare) Then
elm.Select
gotoRange rng:=Selection.Range
elm.Select
MsgBox prompt:="See next"
End If
Next elm
End Sub

Sub gotoRange(rng As Range)
ActiveWindow.ScrollIntoView rng
End Sub

 

[Fuzzhead]

periodic,

I tried your new findit macro useing my old newline and it worked. It kind
of jumped around but it did find them all. I tried your insertLine macro but
it gives me the following error: Object has been deleted.

It is at the following code: idx = ActiveDocument.Variables("idx") + 1

Fuzzhead

 

[Russ]

Fuzzhead,
Try this change to the macro.

Sub insertLine()

Dim i As Long
Dim j As Long
Dim idx As Long
Dim num As Long
Dim aVar As Variant

For Each aVar In ActiveDocument.Variables
If aVar.Name = "idx" Then
num = aVar.Index
Exit For
End If
Next aVar

If num = 0 Then
ActiveDocument.Variables.Add Name:="idx", Value:=0
End If

idx = ActiveDocument.Variables("idx").Value + 1
i = Selection.Information(wdVerticalPositionRelativeToPage)
j = InchesToPoints(1)
ActiveDocument.Shapes.AddLine(562, i, 562, j + i).Name = "vline" & idx
ActiveDocument.Variables("idx").Value = idx

End Sub

 

[Fuzzhead]

Thank you Russ. That worked. I have another shape macro that I use. The
problem is when I run the findPCN macro it will only find the first
occurrence in each case. Is there a better way to write my first macro so I
can use periodic’s findit macro?

Sub PCNHighlight()
Dim idx As Long
Dim PCN As Shape
Dim i
On Error GoTo endthis

i = Selection.Information(wdVerticalPositionRelativeToPage)
Select Case Selection.Style
Case ActiveDocument.Styles(wdStyleHeading1)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 48, i - 3, 32,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNa" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading2)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 48, i - 3, 32,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNb" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading3)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 85, i - 3, 40,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNc" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading4)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 129, i - 3, 25,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNd" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading5)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 153, i - 3, 25,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNe" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading6)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 174, i - 3, 25,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNf" & idx
idx = idx + 1

Case ActiveDocument.Styles(wdStyleHeading7)
Set PCN = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 199, i - 3, 25,
18#)
PCN.Fill.ForeColor.RGB = RGB(150, 150, 150)
PCN.Fill.Transparency = 0.3
PCN.Line.Visible = msoFalse
PCN.Name = "PCNg" & idx
idx = idx + 1

endthis:
End Select
End Sub


periodic’s findit macro
Sub findPCN()

Selection.HomeKey unit:=wdStory, Extend:=wdMove
Dim elm As Shape

For Each elm In ActiveDocument.Shapes
If InStr(1, elm.Name, "PCN", vbTextCompare) Then
elm.Select
gotoRange rng:=Selection.Range
elm.Select
MsgBox prompt:="See the next PCN Number"
End If
Next elm
End Sub

 

[Russ]

Fuzzhead,
Now that we have gone through this programming exercise, I have to ask, why
do you need to do this?

The bookmark function does the same thing by insertion point, selection of
text or object. You give the bookmark a name and using the menus
Edit/Goto... Bookmark or Insert/Bookmark... can go to any named bookmark.
The Browse buttons on each document's window below the vertical scrollbar
can goto previous or next object. Or the keys Control/Page Down and
Control/Page Up move browse next or browse previous.

Tools/Track Changes... is for edit control in documents.

Insert/Comments can also mark text with information.

 

[periodic]

Well the problem is the same as in your first insert line macro. The idx
variable is not saved between the runs of the macro and when you create the
next rectangle for a certain style it will have the same name as the
previous, i.e. all heading 1 styles will get the name PCNa0. However Word
does not allow two shapes to have to same name and refuses to change the name
of the second rectangle. Giving it the name Rectangle n (where n is the next
free number).
Thus you must add the idx variable as a document variable. Bu running
fuzzheads code:

'... Some init stuff

For Each aVar In ActiveDocument.Variables
If aVar.Name = "idx" Then
num = aVar.Index
Exit For
End If
Next aVar

If num = 0 Then
ActiveDocument.Variables.Add Name:="idx", Value:=0
End If

.... Do stuff with idx

ActiveDocument.Variables("idx").Value = idx

End Sub

This way idx get saved between the runs and say that you increase it to 1
the first run of the macro the idx variable is stored in the document as a
variable ready for use in the next run of the macro.

But as Fuzzheas says, for headings I would use the goto function

 

[Fuzzhead]

Thank you both for all the help.

I am new to Word and don't know all that it can do. I have been going
through this site when I try to write a macro. I know that there are easer
way to do some things but I don't know where to look and find it. There is so
much info here that I find something close to what I need and then work on
it.

Fuzzhead

 

[Russ]

Fuzzhead,
You're not the first one to try and re-invent the wheel. That's why I
thought I should ask what you were trying to do. I don't want to discourage
you from using macros because they can make you more productive in other
ways, too. I don't know everything about Word and learn something every day
by reading various forums. We all had to start at the beginning. Here are
some useful sites:
<http://word.mvps.org/>
<http://www.addbalance.com/word/>
<http://gmayor.com/Word_pages.htm>

 

[Fuzzhead]

Russ,

Thanks for your help and the sites. I have bookmarked them as favorites and
will start using them.

Fuzzhead