Solved: How to Find Name of Bookmark Selected?

[geedee65]

I have a macro that inserts a picture (inlineshape) into a cell within a table when a MacroButton is clicked.

The macro then resizes the picture to the cells dimensions, without distorting the picture and applies a named bookmark to the picture.

Through VBA, is there a way to determine the name of the Bookmark when the user selects any of the pictures already inserted?


I've tried,

Sub ReDoPic()
Dim BMname As String
BMname = Selection.Bookmarks(1).Name
End Sub

but this picks up the bookmark name of the table that picture is within and not the picture (inlineshape)!

As there can be up to 2 pictures in each table, with 21 tables in the document, I need to know which picture is selected.

The reason I want to do this, is to be able to update the picture a user selects, (through the same macro that inserts the original picture) attached to a custom menu.
Because each cell that has a MacroButton to insert a picture is linked to a particular picture file.

here is the macro,
Sub InsertPic(Fldr As String, Ttl As String, Xtn As String, BMname As String)
' 03/02/2008 by Glen D. Atkinson
'Inserts a picture from a determined filepath and resizes according to cell dimensions.
Dim NewPic As InlineShape
Dim ScleFctr As Long
Dim MaxW As Long
Dim MaxH As Long
Dim MinW As Long
Dim MinH As Long
Dim PicW As Long
Dim PicH As Long
Application.ScreenUpdating = False
'Determine size range of pic
If BMname = "PicPhase" Then
MaxW = 355
MaxH = 225
MinW = 340
MinH = 210
Else
MaxW = 265
MaxH = 125
MinW = 250
MinH = 110
End If
' Select the Bookmark (same as MacroButton)
ActiveDocument.Bookmarks(BMname).Range.Select
' Select pic to insert
On Error Resume Next
Set NewPic = Selection.InlineShapes.AddPicture(FileName:=Fldr & Ttl & Xtn, _
LinkToFile:=True, SaveWithDocument:=True)
If NewPic Is Nothing Then
MsgBox "This Picture Does Not Exist!" & vbCrLf & "Check Picture exists" _
& vbCrLf & "Check That Picture Is a .jpg" & vbCrLf & "Check Picture File Name", _
vbOKOnly, "MR Plus"
Set NewPic = Nothing
Exit Sub
Else
'add picture & if not full size, adjust to full size
If NewPic.ScaleHeight <> 100 Then
NewPic.ScaleHeight = 100
End If
If NewPic.ScaleWidth <> 100 Then
NewPic.ScaleWidth = 100
End If
'Determine if pic is bigger than table cell size and re-size
If NewPic.Width > MaxW Or NewPic.Height > MaxH Then
If (NewPic.Width - MaxW) < (NewPic.Height - MaxH) Then
ScleFctr = (MaxW / NewPic.Width) * 100
NewPic.ScaleWidth = ScleFctr
NewPic.ScaleHeight = ScleFctr
Else
ScleFctr = (MaxH / NewPic.Height) * 100
NewPic.ScaleWidth = ScleFctr
NewPic.ScaleHeight = ScleFctr
End If
'Or determine if pic is smaller than table cell size and re-size
ElseIf NewPic.Width < MinW Or NewPic.Height < MinH Then
If (NewPic.Width - MinW) > (NewPic.Height < MinH) Then
ScleFctr = (MaxW / NewPic.Width) * 100
NewPic.ScaleWidth = ScleFctr
NewPic.ScaleHeight = ScleFctr
Else
ScleFctr = (MaxH / NewPic.Height) * 100
NewPic.ScaleWidth = ScleFctr
NewPic.ScaleHeight = ScleFctr
End If
End If
'Re-create bookmark
Selection.Collapse Direction:=wdCollapseStart
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ActiveDocument.Bookmarks.Add BMname
Selection.Collapse Direction:=wdCollapseStart
Set NewPic = Nothing
End If
Application.ScreenUpdating = True

I kept the link to the picture, so if the picture was replaced or edited, the link could then be updated, but of course it does not re-size the picture to the dimensions required.

Any suggestions?

And many thanks to those that have posted code for inserting and re-sizing pictures in tables in this forum, it all helped put together the above code.

Also, being a novice at Word vba, any suggestions at improving the above code would be great!

[geedee65]

The attachment contains the template, an example document produced from the template & 3 example pics that all require to be on the 'C' Drive.

[gwkenny]

Here is the template, so you can see the tables, bookmarks, etc.
Help us to help you by doing the following:

1) If you are going to submit a template, please remove ALL environment checks to see if your code is running on a valid computer. What is particularly disturbing with what you submitted is that if the computer is not "valid" it exits Word without saving. Thus all other documents open will not have their changes saved before Word exits. Not a particularly nice thing to do to people who are trying to help you!!!

2) Your code bombs if you do not make a change to the document number. File names cannot contain question marks. May want to code some additional error checking so this doesn't happen for your users.

3) You submit the template with code, but no supporting pictures. At this point, I didn't even bother trying to sort through the relevant code of where you get jpgs from.

4) Having the template and understanding what you need... You didn't have to submit anything. Just took me a lot more time than necessary to get an answer because I had to decode the "problems" with your template operating before I looked into the problem. Then I had to decipher your code that inserts the pic and adds another bookmark.

_____________________________________________

I'm ASSuMEing that the User is going to click to select the pick to redo and then run your macro via your KCC menu....

If that is the case, then the following line should give you your bookmark name:

MsgBox Selection.Bookmarks(2).Name

Bookmarks(1) is the bookmark you assigned to the table.

To make the code tighter, you want to loop through all the bookmarks in the selection to make sure it only holds one valid "picture" bookmark, then proceed accordingly.

[geedee65]

Help us to help you by doing the following:

1) If you are going to submit a template, please remove ALL environment checks to see if your code is running on a valid computer. What is particularly disturbing with what you submitted is that if the computer is not "valid" it exits Word without saving. Thus all other documents open will not have their changes saved before Word exits. Not a particularly nice thing to do to people who are trying to help you!!!


ooppssss ... sorry I did mean to deactivate that before zipping.
It's now deactivated.


2) Your code bombs if you do not make a change to the document number. File names cannot contain question marks. May want to code some additional error checking so this doesn't happen for your users.

I've changed to zeros to stop this happening.


3) You submit the template with code, but no supporting pictures. At this point, I didn't even bother trying to sort through the relevant code of where you get jpgs from.

Pictures now included in the zipped file, as well as a test document.


4) Having the template and understanding what you need... You didn't have to submit anything. Just took me a lot more time than necessary to get an answer because I had to decode the "problems" with your template operating before I looked into the problem. Then I had to decipher your code that inserts the pic and adds another bookmark.


I added the template after a couple of days of originally asking the question ........ just thought the template might clarify what i was trying to do in the overall picture of things, where as the original post was for a very specific point ...... It certainly wasn't meant to confuse anyone.

Thank you for your help so far, greatly appreciated ......

[Tinbendr]

Here is a link to answer (http://word.mvps.org/faqs/tblsfldsfms/GetCurFmFldName.htm) you original question.

[gwkenny]

Not sure that link helps him as there are no formfields in the document.

I'm not quite sure what geedee wants.

His code: "BMname = Selection.Bookmarks(1).Name" gives him the bookmark of the table.

geedee asked for the bookmark of the picture. I gave him that code:

"msgbox Selection.Bookmarks(2).Name"

That will give him the bookmark name of the picture selected provided there are ONLY 2 bookmarks covered in the selection.

ASSuMEing user are idiots :) and might highlight a whole section or table instead of just one picture, I suggested geedee loop through all the bookmarks to determine there is only one "valid" picture bookmark (and should probably check the selection type as well).

I actually thought I answered the original question. Getting the picture's bookmark. Maybe geedee wants the entire code of replacing the picture? I don't know.

[geedee65]

I used the "Selection.Bookmarks(2).Name" to get the name of the selected bookmark (thank you gwkenny), though still not sure how to loop through bookmarks to determine if the selection is a valid picture bookmark.
Which I guess I should do, as more bookmarks may be added to select rows, columns or ranges of cells at a future stage!

And yes, the user will select the picture and then run the macro via a choice on the KCC Menu.
This macro being exactly the same one that inserts the picture in the first instance.

I've modified the macro slightly since I posted the one above, as I found some picture sizes that did not work too well.
So far, so good with testing of this new one .....
Sub InsertPic(Fldr As String, Ttl As String, Xtn As String, BMname As String)
' 03/02/2008 by Glen D. Atkinson
'Inserts a picture from a determined filepath and resizes according to cell dimensions.
Dim NewPic As InlineShape
Dim MaxW As Long
Dim MaxH As Long
Dim MinW As Long
Dim MinH As Long
Dim PicW As Long
Dim PicH As Long
Dim WRatio As Long
Dim HRatio As Long
Application.ScreenUpdating = False
'Determine size range of pic
If BMname = "PicPhase" Then
MaxW = 350
MaxH = 230
MinW = 340
MinH = 220
Else
MaxW = 265
MaxH = 125
MinW = 255
MinH = 115
End If
' Select the Bookmark (same as MacroButton)
ActiveDocument.Bookmarks(BMname).Range.Select
' Select pic to insert
On Error Resume Next
Set NewPic = Selection.InlineShapes.AddPicture(FileName:=Fldr & Ttl & Xtn, _
LinkToFile:=False, SaveWithDocument:=True)
If NewPic Is Nothing Then
MsgBox "This Picture Does Not Exist!" & vbCrLf & "Check Picture exists" _
& vbCrLf & "Check That Picture Is a .jpg" & vbCrLf & "Check Picture File Name", _
vbOKOnly, "Company"
Set NewPic = Nothing
Exit Sub
Else
'add picture & if not full size, adjust to full size
If NewPic.ScaleHeight <> 100 Then
NewPic.ScaleHeight = 100
End If
If NewPic.ScaleWidth <> 100 Then
NewPic.ScaleWidth = 100
End If
'calculate ratio value of height & width
WRatio = (MaxW / NewPic.Width) * 100
HRatio = (MaxH / NewPic.Height) * 100
'Determine if pic is bigger than table cell size and re-size
If NewPic.Width > MaxW Or NewPic.Height > MaxH Then
If WRatio < HRatio Then
NewPic.ScaleWidth = WRatio
NewPic.ScaleHeight = WRatio
Else
NewPic.ScaleWidth = HRatio
NewPic.ScaleHeight = HRatio
End If
'Or determine if pic is smaller than table cell size and re-size
ElseIf NewPic.Width < MinW Or NewPic.Height < MinH Then
If WRatio < HRatio Then
NewPic.ScaleWidth = WRatio
NewPic.ScaleHeight = WRatio
Else
NewPic.ScaleWidth = HRatio
NewPic.ScaleHeight = HRatio
End If
End If
'Re-create bookmark
Selection.Collapse Direction:=wdCollapseStart
Selection.MoveLeft Unit:=wdCharacter, Count:=1, Extend:=wdExtend
ActiveDocument.Bookmarks.Add BMname
Selection.Collapse Direction:=wdCollapseStart
Set NewPic = Nothing
End If
Application.ScreenUpdating = True
End Sub

Now all I have to do is simplify all the other code in the template......

[Tinbendr]

Not sure that link helps him as there are no formfields in the document.You're right. I was looking for something else and stumbled on that link. Guess I didn't read the subject line close enough. :doh:


I suggested geedee loop through all the bookmarks...I agree.

[fumei]

Glen, could you post a cleaned up version? I do not want to go through what gwkenny did....

[geedee65]

No worries ....

Attachment contains the template only.

[fumei]

No attachment

[geedee65]

Could not zip these example files with the template, file too big.

[Alphacsulb]

Also interested in outcome.