PDA

View Full Version : Add picture to bookmark and delete previous one



MarekReven
09-03-2016, 03:37 PM
At first, want to say hello beacuse it's my first post here :)

I am trying to add picture form hard drive into bookmark named "test" in MS Word
In step 1 (no picture in bookmark) picture is adding to proper place.
In step 2 (picture already in bookmark) when running macro once again, picture is adding just next to old one (without replacing it).


I searched throught many threads (also from this forum) in that case but none of these works.




Sub test2()
Dim test As InlineShape
Dim Rng As Range


With ActiveDocument


'Identify current Bookmark range
If .Bookmarks.Exists("test") Then
Set Rng = .Bookmarks("test").Range
With Rng
'Delete existing image (if applicable)
Debug.Print (a)
While .InlineShapes.Count > 0
Debug.Print (b)
.InlineShapes(1).Delete
Debug.Print (b)
Wend
End With
'Place new image
Set test = .InlineShapes.AddPicture(FileName:="C:\images\250V.png", LinkToFile:=False, Range:=Rng)
End If
Debug.Print (C)
'Re-insert the bookmark
.Bookmarks.Add "test", Rng
Debug.Print (d)


End With

End Sub


I tried also that way:



Sub InsertImage3()
Dim PicPath As String
Dim BmkName As String


PicPath = "C:\images\250V.png"
BmkName = "test"


With ActiveDocument
If .Bookmarks.Exists(BmkName) Then
Dim WrdPic As Word.InlineShape
Set WrdPic = .Bookmarks(BmkName).Range _
.InlineShapes.AddPicture(PicPath, False, True)
End If
End With
End Sub


both ways adding pictures next to each other.

I also tried this version



Sub UpdateBookmarkedImage(BmkNm As String, NewTxt As String)
Dim BmkRng As Range
Dim j As Long
With ActiveDocument
If .Bookmarks.Exists(BmkNm) Then
Set BmkRng = .Bookmarks(BmkNm).Range
BmkRng.InlineShapes(1).Delete
BmkRng.InlineShapes.AddPicture FileName:=NewTxt
.Bookmarks.Add BmkNm, BmkRng
End If
End With
Set BmkRng = Nothing
End Sub


Sub UpdateImage()
Dim BmkNm As String
Dim NewTxt As String
BmkNm = "test"
NewTxt = "C:\Users\Laptop\Desktop\wersje\bkt\images\250V.png"
UpdateBookmarkedImage BmkNm, NewTxt
End Sub


but getting error '5941' The requested member of the collection does not exist, when clicking debug this line is highlighted


BmkRng.InlineShapes(1).Delete


just on other note, I there is better way (more 'rigid') to insert pictures - to give them ID's or so?
I heard that indexes of InlineShapes could be hard to manage if on page will be many images which will change. Please let me know.

gmayor
09-03-2016, 09:32 PM
The following should work


Public Sub ImageToBM(strBMName As String, strImagePath As String)
'Graham Mayor - http://www.gmayor.com
Dim oRng As Range
If Not FileExists(strImagePath) Then GoTo lbl_Exit
With ActiveDocument
On Error GoTo lbl_Exit
Set oRng = .Bookmarks(strBMName).Range
oRng.Text = ""
oRng.InlineShapes.AddPicture _
FileName:=strImagePath, LinkToFile:=False, _
SaveWithDocument:=True
oRng.End = oRng.End + 1
oRng.Bookmarks.Add strBMName
End With
lbl_Exit:
Set oRng = Nothing
Exit Sub
End Sub

gmaxey
09-04-2016, 05:00 PM
Here is another way. InlineShapes have a title property that you could use:


Sub InsertPictureInBookmarkRange()
Dim oRng As Word.Range
Dim oILS As InlineShape
Set oRng = ActiveDocument.Bookmarks("PictureBM").Range
'Clear target range to ensure bookmark range is empty of any previous content.
oRng.Delete
Set oILS = oRng.InlineShapes.AddPicture(FileName:="D:\Replacement Pic.jpg", LinkToFile:=True, SaveWithDocument:=True)
'Re-create the bookmark
ActiveDocument.Bookmarks.Add "PictureBM", oILS.Range
oILS.Title = "Added Picture"
End Sub