Help needed with Macro to Save & Close Word Doc after pasting. Name = Cell reference

[Production Planner]

Hi Guys & Girls,

I need some help with a macro to Save a word doc as a File name based on a value ("C5") in the excel sheet it copied from. Then after it has done this I would like it to close the word doc and return to the spreadsheet.


This is what I have so far for copy and pasting the picture to the word doc.

Sub PullListP1_Picture3_Click()
Dim wdApp As Object
Dim wd As Object
On Error Resume Next
Set wdApp = GetObject(, "Word.Application")
If Err.Number <> 0 Then
Set wdApp = CreateObject("Word.Application")
End If
On Error GoTo 0
Set wd = wdApp.Documents.Open("B:\Staff Folders\cft\Production Planner\ORDER DELIVERY & PRODUCTION PLANNING\PULL LISTS P1\TEMPLATE")
wdApp.Visible = True
Range("B2:I70").CopyPicture xlPrinter, xlPicture
wd.Range.Paste

End Sub

Thanks for you help in advance.


Cheers

 

[brettdj]

Something like this. I have removed the visible command as it isn't needed, plus the file saves over itself

<pls note that I changed my path to test.

hth

Dave

Sub PullListP1_Picture3_Click()
    Dim wdApp As Object
    Dim wd As Object
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
    On Error GoTo 0
    Set wd = wdApp.Documents.Open("C:\temp\10 Apples.docx")
    Range("B2:I70").CopyPicture xlPrinter, xlPicture
    With wd
    .Range.Paste
    .Save
    .Close
    End With
    wdApp.Quit
    Set wdApp = Nothing
End Sub

 

[Production Planner]

Something like this. I have removed the visible command as it isn't needed, plus the file saves over itself

<pls note that I changed my path to test.

hth

Dave

Sub PullListP1_Picture3_Click()
    Dim wdApp As Object
    Dim wd As Object
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
    On Error GoTo 0
    Set wd = wdApp.Documents.Open("C:\temp\10 Apples.docx")
    Range("B2:I70").CopyPicture xlPrinter, xlPicture
    With wd
    .Range.Paste
    .Save
    .Close
    End With
    wdApp.Quit
    Set wdApp = Nothing
End Sub

Thanks for that,

Although I need it to save as a new file every time with the file name taken from the value in cell ("C5") on the current spreadsheet as it is to keep a record of production schedules over a period of time. The value in C5 is the Current date & time.


Any help on this would be greatly appreciated.

Cheers

 

[brettdj]

What format is the date and time in?

This version does a saveas with a date stamp of dd mmm yy (presuming the C5 value is a date format)

Dave

Sub PullListP1_Picture3_Click()
    Dim wdApp As Object
    Dim wd As Object
    On Error Resume Next
    Set wdApp = GetObject(, "Word.Application")
    If Err.Number <> 0 Then Set wdApp = CreateObject("Word.Application")
    On Error GoTo 0
    Set wd = wdApp.Documents.Open("C:\temp\sample.docx")
    Range("B2:I70").CopyPicture xlPrinter, xlPicture
    With wd
    .Range.Paste
    .SaveAs "C:\temp\" & Format(ActiveSheet.[c5].Value, "dd mmm hh") & ".docx"
    .Close
    End With
    wdApp.Quit
    Set wdApp = Nothing
End Sub