Solved

How can I insert a floating shape (by that I mean a picutre file) right above a bookmarked word progromaticly using word vba

Posted on 2013-06-23
27
425 Views
Last Modified: 2013-06-24
I am using word 2010I got the following code from the great Grahamskan and it worked like a dream . Then I was not working with it for a few months and when I tired using it again it totaly did not put the picture in the right place at all???all??? here is the original code
Sub AddShapeAtBookMark()
    Dim sh As Shape
    Dim rng As Range
    Set rng = ActiveDocument.Bookmarks("bmk1").Range

    Set sh = ActiveDocument.Shapes.AddShape(msoShapeRectangle, 0, 0, 30, 10, rng)
    
    sh.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    sh.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    sh.Left = rng.Information(wdHorizontalPositionRelativeToPage)
    sh.Top = rng.Information(wdVerticalPositionRelativeToPage) + 12
End Sub

Open in new window

Here is my actual macro that I use that stopped working
Set kl = ActiveDocument.Shapes.AddPicture(FileName:=imagePath, _
    LinkToFile:=False, _
    SaveWithDocument:=True, Width:=35, _
    Height:=35)
          kl.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    kl.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    kl.Left = rng.Information(wdHorizontalPositionRelativeToPage)
    kl.Top = rng.Information(wdVerticalPositionRelativeToPage)

Open in new window

0
Comment
Question by:Dov_B
  • 13
  • 9
  • 5
27 Comments
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
This works fine for me in Word 2010
Sub test(imagePath As String)
    Dim kl As Shape
    Dim rng As Range
    Set rng = ActiveDocument.Bookmarks("bkmk1").Range

    Set kl = ActiveDocument.Shapes.AddPicture(FileName:=imagePath, LinkToFile:=False, SaveWithDocument:=True, Width:=35, Height:=35)
    kl.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    kl.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    kl.Left = rng.Information(wdHorizontalPositionRelativeToPage)
    kl.Top = rng.Information(wdVerticalPositionRelativeToPage)

End Sub

Open in new window

0
 

Author Comment

by:Dov_B
Comment Utility
well the macro works but it is totaly putting the picture in the wrong place is it possible one of my children messed around with some setting somewhere in the computer that may have suddenly caused the computer to use the wrong measuring system?
0
 

Author Comment

by:Dov_B
Comment Utility
I just thought of something I am using an xp machine now could that be throwing it off
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Dov B(er),

Not sure what the wrong place is, the macro in my previous post inserts the top left corner of the picture at the location of the bookmark.

btw, I'm also using Windows XP. The computers measuring system has nothing to do with it.
0
 

Author Comment

by:Dov_B
Comment Utility
can you take a look at this screenshot and see how far off base it has put it? A GROISEN YASHER KOIACH!
image-ms-word.png
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
You haven't shown the code that sets the Range(rng). Hopefully it is in the actual macro.

Can you post the document, or at least give more details? How far out is the position of the shape from what you expect?
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
That is weird, as Graham wrote - it would help to see the actual document.
0
 

Author Comment

by:Dov_B
Comment Utility
test(imagePath, bmname)
    Dim kl As Shape
    Dim rng As Range
    Set rng = ActiveDocument.BookMarks(bmname).Range

    Set kl = ActiveDocument.Shapes.AddPicture(FileName:=imagePath, LinkToFile:=False, SaveWithDocument:=True, Width:=35, Height:=35)
    kl.RelativeHorizontalPosition = wdRelativeHorizontalPositionPage
    kl.RelativeVerticalPosition = wdRelativeVerticalPositionPage
    kl.Left = rng.Information(wdHorizontalPositionRelativeToPage)
    kl.Top = rng.Information(wdVerticalPositionRelativeToPage)

Open in new window

The paths of the pictures and the names of the bookmarks are stored in a database, and passed to the macro as arguments or parameters (I forgot the official term)

here is the macro that passes the parameters

Sub InsertAllPicsInDatabase()
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Please navigate to the folder that contains the pics"
    .AllowMultiSelect = False

    If .Show <> 0 Then

        Dim picFolderPath
        picFolderPath = .SelectedItems(1)

    Else

        MsgBox "Dialog cancelled"

    End If

End With
Dim picShortName
Dim cn As New ADODB.Connection
Dim rs As New ADODB.Recordset
Dim s, x
Dim j, bmname, picfile
Dim dbName
dbName = ActiveDocument.Variables.Item("DataBasePath")

Application.ScreenUpdating = False
cn = "DRIVER=SQLite3 ODBC Driver;Database=" & dbName & ";" _
& "LongNames=0;Timeout=1000;NoTXN=0;SyncPragma=NORMAL;StepAPI=0;"

cn.ConnectionString = cn
s = "select * from bm"
cn.Open
rs.Open s, cn
rs.GetRows

With rs
    .MoveFirst
    Do Until rs.EOF = True
nn:
    
    bmname = .Fields("bmname").Value
    'If Right(bmname, 2) < 83 Then GoTo nn 'bmname = "bm10"
    picShortName = .Fields("picfile").Value
    picfile = picFolderPath & "\" & picShortName
    If Not IsNull(picfile) Then test picfile, bmname 'AddPictureAtBookMark4INI bmname, picfile, picShortName
    x = x + 1
    If x > 5 Then
    ActiveDocument.Save: x = 0: End If
    'Get the value you want off the last record (newest date)
    .Move (1)
    Loop
End With
rs.Close
cn.Close
Application.ScreenUpdating = True
End Sub

Open in new window

0
 

Author Comment

by:Dov_B
Comment Utility
hang on I am going to send you the whole thing it will take me a few minutes to put it together the macros are stored in normal.dot and I got to put them into a module also I got send you the sql database
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
Not sure if it makes any difference, but you don't seem to be using the anchor parameter (rng) in the AddPicture line.
0
 

Author Comment

by:Dov_B
Comment Utility
I just added it and it made no difference heres is a screenshot with arrows pointing from the picture to the book mark it should have been next to
6-24-2013-6-56-31-AM.png
0
 

Author Comment

by:Dov_B
Comment Utility
I added some debugging subroutines if you could take a look
Sub myDebugging()
Dim bm As Bookmark
Dim kl As Shape
Dim x
For Each bm In ActiveDocument.BookMarks
bm.Select

MsgBox (bm.Range.Information(wdVerticalPositionRelativeToPage) & ":" & Selection.Range.Information(wdVerticalPositionRelativeToPage))
x = x + 1: MsgBox (ActiveDocument.Shapes(x).RelativeVerticalPosition)
Next
End Sub

Open in new window

test.docx
0
 

Author Comment

by:Dov_B
Comment Utility
whoops wrong file sorry here it is wait it wont let me upload a docm
0
6 Surprising Benefits of Threat Intelligence

All sorts of threat intelligence is available on the web. Intelligence you can learn from, and use to anticipate and prepare for future attacks.

 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
There are no bookmarks in that file.
0
 

Author Comment

by:Dov_B
Comment Utility
hang on rename the extension .docm
Copy-of-test.doc
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
If necessary, you can export a code module and attach it along with a macro-free version of the document.
0
 
LVL 76

Expert Comment

by:GrahamSkan
Comment Utility
bad timing
0
 
LVL 26

Accepted Solution

by:
MacroShadow earned 450 total points
Comment Utility
The problem is you are using web layout, the code will only work in print layout.
0
 

Author Comment

by:Dov_B
Comment Utility
wow how the heck did you figure that out may you be blessed with everything good!
how do I get the layout corrected?!
0
 
LVL 76

Assisted Solution

by:GrahamSkan
GrahamSkan earned 50 total points
Comment Utility
View tab
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
or in the bottom corner.
sh.bmp
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
DB, all the best, glad to have been of assistance.
0
 

Author Comment

by:Dov_B
Comment Utility
hang on I reran the macro and its still not putting the pictures in the right place is that because I added the book marks in web layout?
0
 

Author Comment

by:Dov_B
Comment Utility
wa-a-a-a-a-a-i-i-i-it! Ple-e-ee-ase dont go away ! It is still not working
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
We're still here. To discover if that is the issue recreate the bookmarks in print view.
0
 

Author Comment

by:Dov_B
Comment Utility
Gevaldig! It works! May G-d bless the two of you over and over again! Because of your generosit many learning disabled will be helped. G-d Bless you!
0
 
LVL 26

Expert Comment

by:MacroShadow
Comment Utility
Baruch HaShem.
0

Featured Post

Threat Intelligence Starter Resources

Integrating threat intelligence can be challenging, and not all companies are ready. These resources can help you build awareness and prepare for defense.

Join & Write a Comment

The Selection object is designed for user interaction. It has a Range property, so it can be used in most places that a Range object can. Recorded macros must use the Selection because they are simply copying what the user is doing. A Range prope…
A few years ago I was very much a beginner at VBA, and that very much remains the case today.  I'll do my best to explain things as I go in the hope that other beginners can follow.  If you just want to check out a tool that creates a Select Case fu…
In a previous video Micro Tutorial here at Experts Exchange (http://www.experts-exchange.com/videos/1358/How-to-get-a-free-trial-of-Office-365-with-the-Office-2016-desktop-applications.html), I explained how to get a free, one-month trial of Office …
This Experts Exchange video Micro Tutorial shows how to tell Microsoft Office that a word is NOT spelled correctly. Microsoft Office has a built-in, main dictionary that is shared by Office apps, including Excel, Outlook, PowerPoint, and Word. When …

744 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

13 Experts available now in Live!

Get 1:1 Help Now