Excel VBA Course
Excel VBA Course - From Beginner to Expert

200+ Video Lessons
50+ Hours of Video
200+ Excel Guides

Become a master of VBA and Macros in Excel and learn how to automate all of your tasks in Excel with this online course. (No VBA experience required.)

View Course

How do you write a code that would transfer an image in an Excel cell to a specific bookmark in a Word document?

0

Hi there,

So right now, I'm using a working code that transfers Excel data into a single Word document (Big thanks to John_ru for the code). The entire code is in the VBA writer in the Excel file. 

I was wondering if it was possible to also transfer an image file on a cell into a specific bookmark in the Word document. 

Before I tried this code but it didn't work. It seemed to me like the image was just floating above the cell and not actually in the cell. Also, it got too long and repetitive because I had to do this 100 times - there were 100 labels in the word document, but for the example, I just put in two. 

'QR Code

        wd.Selection.Goto what:=wdGoToBookmark, Name:="qr_code1"
        wd.Selection.TypeText Text:=sh.Range("P2").Value

Apologies for my English, it's not my primary language but I hope it's understandable. The word document is in the Excel file as well, attached as an object (big thanks to John_ru as well for teaching me that)

Also, for this question, I just added the column for the Qr code. The entire code was written without that entire column in mind. But without that column, the code works wonderfully. 

Answer
Discuss

Answers

0
Selected Answer

Hi Benjamin

I've modifed the code to allow for the extra column (its effect on the loop and source of document name) and added code to copy paste the QR code from column 16 (P) into Word bookmarks like qr_1 and qr_2 - these are in the revised tempate (embedded in the Excel workbook attached) which needs storing in the same folder as the workbook.

Only the For loop changes really and that's to loop through the shapes and see if they are "in" the cell. My understanding is that they are really in the drawing layer above the cells but we can use the Shapes.TopLeftCell property which returns the address of the cell where the top left corner is positioned above. I compare that with the address of cell in the loop (when iCol=16) and just copy/paste the shape (QR code) into Wiord if there's a match.

The key changes are in bold in the extract below:

For iCol = 1 To 16 'from column A to P...
    TargBook = sh.Cells(1, iCol).Value & "_" & iRow - 1 'create target bookmark name
    If WdDoc.Bookmarks.Exists(TargBook) = True Then  'check header bookmark exists then...
        If iCol <> 16 Then ' for text columns...
            wd.Selection.Goto what:=wdGoToBookmark, Name:=TargBook
            wd.Selection.TypeText Text:=sh.Cells(iRow, iCol).Value 'take column value from loop row
            WdDoc.Bookmarks(TargBook).Delete ' delete bookmark

            Else 'where the QR codes or other images are stored

            Dim Shp As Shape ' declare for shapes in worksheet
            For Each Shp In sh.Shapes 'loop through shapes to see if they are over the cell
                If sh.Cells(iRow, iCol).Address = Shp.TopLeftCell.Address Then
                    Shp.Copy ' if so copy it
                    wd.Selection.Goto what:=wdGoToBookmark, Name:=TargBook
                    wd.Selection.Paste ' and paste qr in bookmark
                End If
            Next Shp
            WdDoc.Bookmarks(TargBook).Delete ' delete bookmark

        End If
    Else
        n = MsgBox("Please check template; cannot find Word bookmark: " & TargBook, vbOKOnly) ' Tell user something's missing
        Exit Do 'then stop populating Word document
    End If
Next iCol
Again other users should note that the code relies on the Microsoft Word 16.0 Object library (or other version) being installed already (via VB Editor/Tool/References).

I think this should work for you but this approach may be too slow when you have lots of rows (/labels).

If so, it may be necessary to collect all the shape/address data before the Do While loop is run (and not repeat the checks for each cell in column P). Out of interest only (for now), I've left new Module2 in the workbook- that collects the names of shapes and the "top left cell" addresses into a 2-D array (and prints them into the Intermediate pane of the VB Editor):

Sub GetShpAddr()
' populate an array with the cell addresses for shapes in sheet
Dim Shp As Shape, ShpTot As Long
Dim ShpAddrs() As Variant

ShpTot = ActiveSheet.Shapes.Count
ReDim ShpAddrs(1 To ShpTot, 1 To 2)
i = 1
For Each Shp In ActiveSheet.Shapes
    ShpAddrs(i, 1) = Shp.TopLeftCell.Address
    ShpAddrs(i, 2) = Shp.Name
    Debug.Print ShpAddrs(i, 1) & ": " & ShpAddrs(i, 2)
    i = i + 1
Next Shp

End Sub
Hope this helps.
Discuss

Discussion

Any joy with this approach?
John_Ru (rep: 6092) Jun 23, '21 at 8:22 am
It worked perfectly. Thank you, John! I've been researching this for almost two weeks now with nothing to show for. Really appreciate your time in writing it. 

Do you happen to know if these types of coding would be in the course? It seems lightyears beyond what I know now but I would really love to at least be able to do a fraction of it on my own. I'm waiting for the course to be done then I'm taking it.
SoupierAuthor (rep: 4) Jun 23, '21 at 9:35 am
Great and thanks for selecting my Answer.

For learning VBA and Excel in general, you'll get tutorial links via email from the Don, the TeachExcel site owner (I assume you're signed up for the newsletter). He has made many very good tutorials which you'll find on the Tutorials section of this site. There is a subsection on VBA including 6 basic lessons (and more) which you'll find handy. First lesson is here Excel Macros Class 1 - Getting Started Programming Macros

Don has been preparing a full VBA course I believe (which should be comprehensive and a paid course). There are free courses on the internet (but I'm so old that I learned from books and experience!).

Good luck!
John_Ru (rep: 6092) Jun 23, '21 at 10:23 am
Thanks! I've actually gone through the free stuff from YouTube, that's how I found you guys. I guess all that's left is to practice and wait for the comprehensive course to be finished. 
SoupierAuthor (rep: 4) Jun 24, '21 at 12:28 am
Add to Discussion
0

You made a lot of significant changes to your workbook, not the least of which is to embed the Word template in the Excel file. I'm not sure if that is its final location but I modified your code to be able to access that document. Then I added code to copy the QR code from the worksheet to the document. For this purpose I added bookmarks called qr_code_1 and qr_code_2. 

The code modifies all the bookmarks, and at that point I stopped my intervention. You will see the final lines of code about savng the work are  remmed out in the attached workbook. That doesn't imply any judgment about their usefulness. I just didn't look at them but presume that they will work same as before.

Discuss

Discussion

Hi there, thanks for answering! The code works. 

My plan is to make the code work when the Excel file template and the Word file template are both in the same folder and then a new Word document will be created with the information, can you kindly point me to where I can make these changes? Sorry, I'm a real newbie with coding.
SoupierAuthor (rep: 4) Jun 23, '21 at 6:52 am
Hi,
New or not new, it's your code and you will have to own it or miss out on the fun. Look for this line of code.
If Not GetWordDocument(Sh, WdApp, WdDoc) Then GoTo SideExit

It leads to this line of code:-
Set WdDoc = .Object

At this line the WdDoc document is created from the embedded Word document object in the worksheet. In your previous code that same object was created from a template stored on your hard disk. So, all that needs to be done is to remove the function call first above quoted and replace it with the code that created the the object in a different way. I don't have that line handy anymore  and I'm pressed for time but I recall that it was something like Set WdDoc = Documents.Open ... It's just to replace one method of creating the WdDoc object with another. It's not complicated and doing it will give you confidence.
My function will become obsolete in the process.
Note that I may not be able to continue this conversation until next week.
Variatus (rep: 4889) Jun 23, '21 at 7:41 am
Thank you for the response! Makes sense now. 
SoupierAuthor (rep: 4) Jun 23, '21 at 10:10 am
I'm glad you got it fixed. Please don't forget to mark my answer as "Selected".
Variatus (rep: 4889) Jun 23, '21 at 10:33 am
Add to Discussion


Answer the Question

You must create an account to use the forum. Create an Account or Login