VBA excel to word doc

[Pinaceous]

Hi All,

I have a code to put my excel onto a word doc in updating the Word Object Library in excel.

I would like to know if I can use a word templet for excel in lieu of generating new word document?

Here are my codes:

Sub Excel_to_Word()


Application.ScreenUpdating = False

Application.GoTo Worksheets(3).Range("A1"), True

'Note: This code requires a reference to the Word Object Library to be set.
Dim wdApp As New Word.Application, wdDoc As Word.Document
Dim xlRng As Excel.Range, r As Long, c As Long, FlNm As String
With ActiveWorkbook
  FlNm = ActiveSheet.Name & " " & Format(Now, "YYYYMMDD_hhmm") & ".docx"
  With .ActiveSheet
    With .UsedRange.Cells.SpecialCells(xlCellTypeLastCell)
      r = .Row
      c = .Column
    End With
    Set xlRng = .Range(.Cells(1, 1), .Cells(r, c))
  End With
End With
With wdApp
  .visible = True
  '.Select
   '.Activate
 
  Set wdDoc = .Documents.Add
  xlRng.Copy
  With wdDoc
        With .PageSetup
      .PaperSize = wdPaperLetter
      .Orientation = wdOrientPortrait
      .LeftMargin = wdApp.InchesToPoints(0)
      .RightMargin = wdApp.InchesToPoints(0.25)
      .TopMargin = wdApp.InchesToPoints(0.25)
      .BottomMargin = wdApp.InchesToPoints(0.45)
        End With
    .Range.PasteExcelTable LinkedToExcel:=False, WordFormatting:=False, RTF:=False
    '.SaveAs Filename:=FlNm, FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
    '.Activate
   
    ActiveWindow.WindowState = xlMinimized
   
      With wdApp.Dialogs(wdDialogFileSaveAs)
        .Name = FlNm
        .AddToMRU = False
       
If .Show = False Then GoTo Canceled


    End With
    .Close False
  End With
  .Quit
End With
Application.CutCopyMode = False
Set xlRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing

    ActiveWindow.WindowState = xlMaximized
     
    'Application.Goto Worksheets(28).Range("A1"), True
   
    'Application.ScreenUpdating = True


   Exit Sub

Canceled:
     
       
    ActiveWindow.WindowState = xlMaximized
   
    Call CloseWord
   
    Application.ScreenUpdating = True

    'Application.Goto Worksheets(28).Range("A1"), True


Exit Sub


End Sub


Sub CloseWord()

    Dim W As Object
    On Error Resume Next
    Set W = GetObject(, "Word.Application")
    If W Is Nothing Then Exit Sub
    W.ActiveDocument.Close savechanges:=False
    W.Quit
    Set W = Nothing
 
End Sub

I'm thinking something like this:

    Set Word.Document = Word.Document.CreateItemFromTemplate("S:\\Titled.msg")   'Change path to object.

Please let me know, if you have any suggestions.


Thanks!
pinaceous

 

[DanteAmor]

In the following code I highlighted the changes I made. If you are going to paste into a template you must change the way you paste, otherwise, with the method you are using delete the entire template.

Try this:

Sub Excel_to_Word()
  Application.ScreenUpdating = False
  Application.GoTo Worksheets(3).Range("A1"), True
  
  'Note: This code requires a reference to the Word Object Library to be set.
  Dim wdApp As New Word.Application, wdDoc As Word.Document
  Dim xlRng As Excel.Range, r As Long, c As Long, FlNm As String
  With ActiveWorkbook
    FlNm = ActiveSheet.Name & " " & Format(Now, "YYYYMMDD_hhmm") & ".docx"
    With .ActiveSheet
      With .UsedRange.Cells.SpecialCells(xlCellTypeLastCell)
        r = .Row
        c = .Column
      End With
      Set xlRng = .Range(.Cells(1, 1), .Cells(r, c))
    End With
  End With
  
  With wdApp
    .Visible = True
    'Set wdDoc = .Documents.Add
    Set wdDoc = .Documents.Add(Template:=ThisWorkbook.Path & "/" & "test1.dotx", NewTemplate:=False, DocumentType:=0)
    
    xlRng.Copy
    With wdDoc
      With .PageSetup
        .PaperSize = wdPaperLetter
        .Orientation = wdOrientPortrait
        .LeftMargin = wdApp.InchesToPoints(0)
        .RightMargin = wdApp.InchesToPoints(0.25)
        .TopMargin = wdApp.InchesToPoints(0.25)
        .BottomMargin = wdApp.InchesToPoints(0.45)
      End With
    End With
    .Selection.Paste
    ActiveWindow.WindowState = xlMinimized
    With wdApp.Dialogs(wdDialogFileSaveAs)
      .Name = FlNm
      .AddToMRU = False
      If .Show = False Then GoTo Canceled
    End With
    .Quit
  End With
  
  Application.CutCopyMode = False
  Set xlRng = Nothing: Set wdDoc = Nothing: Set wdApp = Nothing
  ActiveWindow.WindowState = xlMaximized
  Exit Sub
  
Canceled:
  ActiveWindow.WindowState = xlMaximized
  Call CloseWord
  Application.ScreenUpdating = True
End Sub

 

[Pinaceous]

Thank you very much DanteAmor!!

 

[DanteAmor]

Im glad to help you, thanks for the feedback.

 

[Ali M]

@DanteAmor I try testing the code but it gives me error "application not defined or object defined error "
in this line

 Set wdDoc = .Documents.Add(Template:=ThisWorkbook.Path & "/" & "test1.dotx", NewTemplate:=False, DocumentType:=0)

I suppose creating new word file automatically without interfere from me, right?
I use office 2019.

 

[DanteAmor]

Set wdDoc = .Documents.Add(Template:=ThisWorkbook.Path & "/" & "test1.dotx", NewTemplate:=False, DocumentType:=0)
I suppose creating new word file automatically without interfere from me, right?

That line is to create a new document but based on a template called "test1.dotx", that is, you must previously have a word template created in the same folder of the macro with the name "test1.dotx"

 

[Ali M]

"test1.dotx"

this extension makes me confused . I don't used to for this extension .
now it works .
thanks for clarification

 

[DanteAmor]

I'm glad it worked for you.

 

[Pinaceous]

DanteAmor,

This might seem trivial but how do I change the file pathway in your code?

Right now it is set for the test1.docx to be in the same pathway as the folder.

[B]Set wdDoc = .Documents.Add(Template:=ThisWorkbook.Path & "/" & "test1.dotx", NewTemplate:=False, DocumentType:=0)[/B]

Is there a way to specify a pathway for the placement of the test1.docx?

Set Word.Document = Word.Document.CreateItemFromTemplate("S:\\Titled.msg")   'Change path to object.

Many thanks!
pinaceous

 

[Pinaceous]

Is it something like this:

  Set wdDoc = .Documents.Add(Template:=ThisWorkbook.Path & "S:\CMP032A\GROUPS\Depts\Forum\Area\REPORTS\MISC\New folder\Testing\test1.docx", NewTemplate:=False, DocumentType:=0)

But I cannot get it right, thank you!