• Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 458
  • Last Modified:

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

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
Dov_B
Asked:
Dov_B
  • 13
  • 9
  • 5
2 Solutions
 
MacroShadowCommented:
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
 
Dov_BAuthor Commented:
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
 
Dov_BAuthor Commented:
I just thought of something I am using an xp machine now could that be throwing it off
0
Free Tool: Path Explorer

An intuitive utility to help find the CSS path to UI elements on a webpage. These paths are used frequently in a variety of front-end development and QA automation tasks.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

 
MacroShadowCommented:
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
 
Dov_BAuthor Commented:
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
 
GrahamSkanRetiredCommented:
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
 
MacroShadowCommented:
That is weird, as Graham wrote - it would help to see the actual document.
0
 
Dov_BAuthor Commented:
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
 
Dov_BAuthor Commented:
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
 
GrahamSkanRetiredCommented:
Not sure if it makes any difference, but you don't seem to be using the anchor parameter (rng) in the AddPicture line.
0
 
Dov_BAuthor Commented:
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
 
Dov_BAuthor Commented:
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
 
Dov_BAuthor Commented:
whoops wrong file sorry here it is wait it wont let me upload a docm
0
 
MacroShadowCommented:
There are no bookmarks in that file.
0
 
Dov_BAuthor Commented:
hang on rename the extension .docm
Copy-of-test.doc
0
 
GrahamSkanRetiredCommented:
If necessary, you can export a code module and attach it along with a macro-free version of the document.
0
 
GrahamSkanRetiredCommented:
bad timing
0
 
MacroShadowCommented:
The problem is you are using web layout, the code will only work in print layout.
0
 
Dov_BAuthor Commented:
wow how the heck did you figure that out may you be blessed with everything good!
how do I get the layout corrected?!
0
 
GrahamSkanRetiredCommented:
View tab
0
 
MacroShadowCommented:
or in the bottom corner.
sh.bmp
0
 
MacroShadowCommented:
DB, all the best, glad to have been of assistance.
0
 
Dov_BAuthor Commented:
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
 
Dov_BAuthor Commented:
wa-a-a-a-a-a-i-i-i-it! Ple-e-ee-ase dont go away ! It is still not working
0
 
MacroShadowCommented:
We're still here. To discover if that is the issue recreate the bookmarks in print view.
0
 
Dov_BAuthor Commented:
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
 
MacroShadowCommented:
Baruch HaShem.
0

Featured Post

Become an Android App Developer

Ready to kick start your career in 2018? Learn how to build an Android app in January’s Course of the Month and open the door to new opportunities.

  • 13
  • 9
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now