Edit Word document embedded in Excel file using VBA

jchen

New Member
Joined
Oct 27, 2010
Messages
2
Hi,

I'm having problems with editing a Word document that I embedded in the excel file using the insert object tool.
Basically, what I have already done now using VBA is to automatically open a separate existing word document that has an image and a title in the header and to copy from excel to that word document, some text, a range as a picture and some charts as pictures then save it automatically as a new file.
Everything works fine.
But the problem is I have to send this file to other people so they can use it, and for now I have been able to make it work on other computers by sending both excel and word files and telling them to put it in the same folder.
What I would like to do now, is be able to only send the excel file with the word document embedded inside. I have tried googling this but couldn't find a way to open that embedded file and edit it. I thought it would be just be opening the embedded file instead of opening the seperate word file and it would work but it doesn't seem that way or I just don't know how to.
I found these lines which are supposed to open the embedded file but couldn't get it to work.

Worksheets("Sheet1").OLEObjects("Template")

WDApp.Visible = True

I'm pretty new at VBA so I'm not sure what to do. Any help would be greatly appreciated!

Thanks!


Below is the current VBA code that is working when I use a separate word and excel file.

Code:
Sub OpenCopyToWord()

Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim nIndex As Integer

Worksheets("sheet1").Range("S18").Select
    file_path = ActiveCell.Value [I]<-- This links to a cell that has this formula =LEFT(CELL("filename"),FIND("[",CELL("filename"))-1) in it which gives the path of the excel file so that it could work on a different computer[/I]

Worksheets("sheet1").Range("S17").Select
    file_path2 = ActiveCell.Value [I]<-- This links to a cell that has this formula =LEFT(CELL("filename"),FIND("[",CELL("filename"))-1)&"Weekly Spot Price "&TEXT(TODAY()+4-WEEKDAY(TODAY()),"yyyymmdd")&".doc" in it which gives the path of the excel file with the new name of the word document so that it is saved in the same folder[/I]
    
Set WDApp = GetObject(, "Word.Application")
 
Set WDDoc = WDApp.Documents.Open(file_path & "Weekly Price Template.doc")

    WDApp.Visible = True

Worksheets("sheet1").Range("O2").Copy
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial xlPasteValues

    Worksheets("sheet1").Range("O3").Copy
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial xlPasteValues

    Worksheets("sheet1").Range("O4:Q19").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
 
        nIndex = 1
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 83
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 83
  
    Worksheets("sheet1").ChartObjects(4).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
        nIndex = 2
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
    
    Worksheets("sheet1").ChartObjects(1).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
        nIndex = 3
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
    
    Worksheets("sheet1").ChartObjects(2).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
        nIndex = 4
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
    

WDApp.ActiveDocument.SaveAs Filename:=file_path2
    
Set WDDoc = Nothing
Set WDApp = Nothing

     
 
End Sub
 
Last edited:

Excel Facts

Who is Mr Spreadsheet?
Author John Walkenbach was Mr Spreadsheet until his retirement in June 2019.
Hi, were u able to get this working?

I have a similar situation where I need to open an embedded word document and am interested in how this is done.

Cheers,

Tam
 
Upvote 0
Hi,

Yea I managed to get it working by trying some stuff. Here is my final working code

Basically what I changed is this

Hope this helps!

Code:
Set WDObj = Sheets("Sheet1").OLEObjects("Template")

WDObj.Activate
WDObj.Object.Application.Visible = False

Set WDApp = GetObject(, "Word.Application")
 
Set WDDoc = WDApp.ActiveDocument


Code:
Sub OpenCopyToEmbeddedWordDoc()

Dim WDApp As Word.Application
Dim WDDoc As Word.Document
Dim nIndex As Integer

    Application.ScreenUpdating = False


Worksheets("sheet1").Range("S18").Select
    file_path = ActiveCell.Value

Worksheets("sheet1").Range("S17").Select
    file_path2 = ActiveCell.Value

Set WDObj = Sheets("Sheet1").OLEObjects("Template")

WDObj.Activate
WDObj.Object.Application.Visible = False

Set WDApp = GetObject(, "Word.Application")
 
Set WDDoc = WDApp.ActiveDocument

    WDApp.Visible = False

Worksheets("sheet1").Range("O2").Copy
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial xlPasteValues

   Worksheets("sheet1").Range("O3").Copy
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial xlPasteValues
    

    Worksheets("sheet1").Range("O4:Q19").CopyPicture Appearance:=xlPrinter, Format:=xlPicture
    WDApp.Selection.GoTo What:=wdGoToLine, Which:=wdGoToLast
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
    nIndex = 1
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 83
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 83
    
    Worksheets("sheet1").ChartObjects(4).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
     
     nIndex = 2
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
        
    Worksheets("sheet1").ChartObjects(1).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
     nIndex = 3
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
    
    Worksheets("sheet1").ChartObjects(2).Chart.CopyPicture _
    Appearance:=xlPrinter, Size:=xlScreen, Format:=xlPicture
    
    WDApp.Selection.PasteSpecial Link:=False, Placement:=wdInLine, DisplayAsIcon:=False
    
      nIndex = 4
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleHeight = 87
    WDApp.ActiveDocument.InlineShapes(nIndex).ScaleWidth = 87
    
WDApp.ActiveDocument.SaveAs Filename:=file_path2
WDApp.ActiveDocument.Sentences(1).Select
WDApp.ActiveDocument.ActiveWindow.Selection.Copy

WDApp.ActiveDocument.Range.Select
WDApp.ActiveDocument.ActiveWindow.Selection.Paste
WDApp.ActiveDocument.Close


Set WDDoc = Nothing
Set WDApp = Nothing
Set WDObj = Nothing

 Application.ScreenUpdating = True

Set WDApp = GetObject(, "Word.Application")
Set WDDoc = WDApp.Documents.Open(file_path2)
  WDApp.Visible = True
WDApp.Dialogs(wdDialogFilePrint).Display

Set WDApp = Nothing
   
End Sub
 
Upvote 0

Forum statistics

Threads
1,213,567
Messages
6,114,342
Members
448,570
Latest member
rik81h

We've detected that you are using an adblocker.

We have a great community of people providing Excel help here, but the hosting costs are enormous. You can help keep this site running by allowing ads on MrExcel.com.
Allow Ads at MrExcel

Which adblocker are you using?

Disable AdBlock

Follow these easy steps to disable AdBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the icon in the browser’s toolbar.
2)Click on the "Pause on this site" option.
Go back

Disable AdBlock Plus

Follow these easy steps to disable AdBlock Plus

1)Click on the icon in the browser’s toolbar.
2)Click on the toggle to disable it for "mrexcel.com".
Go back

Disable uBlock Origin

Follow these easy steps to disable uBlock Origin

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back

Disable uBlock

Follow these easy steps to disable uBlock

1)Click on the icon in the browser’s toolbar.
2)Click on the "Power" button.
3)Click on the "Refresh" button.
Go back
Back
Top