Export sheet as word doc

[ipbr21054]

Morning,
I am looking to save an excel sheet as a Word doc.
The sheet in question is used as a template & using the print command button saves a copy & then prints it off.

Can you advise how i would export / save as a Word doc.
Code currently in use is shown below & section shown in Red is what i need to replace so i can continue.

Many thanks

Private Sub Print_Invoice_Click()
    Dim answer As Integer
    Dim rng As Range
    Dim Cell As Range
    Dim MyFile As String
    Dim findString As String
    Dim sPath As String, strFileName As String
    Dim srcWS As Worksheet, destWS As Worksheet
    Set srcWS = ActiveWorkbook.Worksheets("INV")
    Set destWS = ActiveWorkbook.Worksheets("DATABASE")
    
    If Range("G13") = "" Then
      MsgBox "NO NAME SELECTED IN THE CUSTOMER DETAILS SECTION", vbCritical, "NO CUSTOMER SELECTED MESSAGE"
      Range("G13").Select 'CHECKING IF CUSTOMER IS SELECTED
    Exit Sub
    End If
  
    If CheckBox1 = False And CheckBox2 = False And CheckBox3 = False Then
    MsgBox "YOU MUST SELECT CAR / BIKE / VAN CHECKBOX TO CONTINUE", vbCritical, "NO CHECKBOX WAS SELECTED"
    Exit Sub  'CHECKING IF CAR BIKE OR VAN IS SELECTED
    End If
    
    If Range("L18") = "" Then
      MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
      Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
    Exit Sub
    End If
    
    If Range("L18") = "TBA" Then
      MsgBox ("PLEASE SELECT A PAYMENT TYPE "), vbCritical, "PAYMENT TYPE WAS NOT SELECTED"
      Range("L18").Select 'CHECKING IF PAYMENT TYPE HAS BEEN SELECTED
    Exit Sub
    End If
    
    strFileName = "C:\Users\there\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
    If Dir(strFileName) <> vbNullString Then
      MsgBox "INVOICE " & Range("L4").Value & " WAS NOT SAVED AS IT ALLREADY EXISTS" & vbNewLine & vbNewLine & "PLEASE CHECK FILE IN FOLDER THAT WILL NOW OPEN.", vbCritical + vbOKOnly, "INVOICE NOT SAVED MESSAGE"
      VBA.Shell "explorer.exe /select, " & "" & strFileName & "", vbNormalFocus 'DUPLICATE INVOICE FOUND
    Exit Sub
    End If
    
    strFileName = "C:\Users\there\Desktop\REMOTES ETC\DR\DR COPY INVOICES\" & Range("L4").Value & ".pdf"
    With ActiveSheet
       .ExportAsFixedFormat Type:=xlTypePDF, fileName:=strFileName, Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False
       
    End With 'CURRENT INVOICE IS NOW SAVED
    
    With Sheets("DATABASE")
      Worksheets("DATABASE").Activate
    End With
    
    Set rng = ActiveSheet.Columns("A:A")
      findString = Worksheets("INV").Range("G13").Value
    Set Cell = rng.Find(What:=findString, LookIn:=xlFormulas, _
      LookAt:=xlWhole, MatchCase:=False) ' CUSTOMER FOUND IN COLUMN A
    
    If Cell Is Nothing Then
      MsgBox "NO CUSTOMER WAS FOUND"
    Else
    With Sheets("DATABASE")
      Cell.Select
      ActiveCell.Offset(0, 15).Select ' CUSTOMERS CELL IN COLUMN P NOW SELECTED
    End With
    End If
    
    If Len(ActiveCell.Value) <> 0 Then
      ValueInInvoiceCell.Show 'MESSAGE SHOWN IF CUSTOMERS INVOICE CELL IN COLUMN P HAS A VALUE IN IT

    Exit Sub
    Else
      TransferInvoiceNumber.Show 'INVOICE NUMBER & DATE FOR CUSTOMERS NOW APPLIED & ALSO HYPERLINKED
    End If
    
    With Sheets("INV")
      Worksheets("INV").Activate
    End With
      
     ActiveWindow.SelectedSheets.PrintOut copies:=1 'INVOICE NOW PRINTED
      MsgBox "INVOICE PRINTED & SAVED", vbInformation, "INVOICE PRINT OK MESSAGE"
      
      If Range("G22") <> "" Then
        
        Workbooks.Open ("C:\Users\there\Desktop\REMOTES ETC\DR\EXCEL WORKSHEETS\MOTORCYCLES.xlsm")
        Worksheets("INVOICES").Activate
        With Sheets("INVOICES")
        .Range("G3").Select
        Call HYPERLINKMC
        End With
        Range("L4").Value = Range("L4").Value + 1
        Range("G27:L36").ClearContents
        Range("G22:G23").ClearContents
        Range("G46:G50").ClearContents
        Range("G13").ClearContents
        CheckBox1 = False
        CheckBox2 = False
        CheckBox3 = False
        Range("D1").Select
        ActiveWorkbook.Save
      Else
        Range("L4").Value = Range("L4").Value + 1
        Range("G27:L36").ClearContents
        Range("G22:G23").ClearContents
        Range("G46:G50").ClearContents
        Range("G13").ClearContents
        CheckBox1 = False
        CheckBox2 = False
        CheckBox3 = False
        Range("D1").Select
        ActiveWorkbook.Save
      End If
    End Sub

 

[Macropod]

You would have to create a Word document, then copy/paste your range to it. For example: The following code exports all worksheets in the Active Workbook to a new Word document named Filename.docx in your Documents folder:

Sub SendExcelSheetsToWordDocument()
'Note: This code requires a VBA reference to be set to Word, via Tools|References.
Dim xlWs As Worksheet, WdApp As New Word.Application, WdDoc As Word.Document
WdApp.Visible = False
Set WdDoc = WdApp.Documents.Add
For Each xlWs In ThisWorkbook.Worksheets
  Application.StatusBar = "Processing: " & xlWs.Name
  xlWs.UsedRange.Copy
  With WdDoc
    .Range.InsertAfter Chr(12)
    .Characters.Last.Paste
  End With
Next
WdDoc.SaveAs2 FileName:="C:\Users\" & Environ("UserName") & "\Documents\Filename.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
WdDoc.Close: WdApp.Quit
Set WdDoc = Nothing: Set WdApp = Nothing: Set xlWs = Nothing
Application.StatusBar = False
End Sub

 

[ipbr21054]

I assume when I run it at first I will get an error & telling me which item I need to select in the Tools / References ?

 

[Macropod]

Did you read the comment at the top of the code? If you don't already have a reference to Word set, then of course you'll get an error message.

 

[jkpieterse]

Why save as Word document? Word can open PDF files. It may mess up some formatting, but perhaps it is good enough?

 

[ipbr21054]

Yea I did read it.
It now so I know what to select ?
This is what I was asking

 

[Macropod]

Simply follow the instructions in the code comment...

 

[ipbr21054]

Ive added the code & have seen an animated circle for the last 10 minutes or so.

Can you advise how to just add my range from the active sheet please
Sheet is called INV & range is F2 N61

 

[ipbr21054]

Please can anybody advise on the code below.

I just need the active sheet called INV & the range F4:N61 to be saved.
Beeb trying for far to long today & got nowhere

    Dim xlWs As Worksheet, WdApp As New Word.Application, WdDoc As Word.Document
        WdApp.Visible = False
    Set WdDoc = WdApp.Documents.Add
    For Each xlWs In ThisWorkbook.Worksheets
        Application.StatusBar = "Processing: " & xlWs.NAME
        xlWs.UsedRange.Copy
    With WdDoc
        .Range.InsertAfter Chr(12)
        .Characters.Last.Paste
    End With
    Next
        WdDoc.SaveAs2 fileName:="C:\Users\" & Environ("UserName") & "\Documents\Filename.docx", FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
        WdDoc.Close: WdApp.Quit
    Set WdDoc = Nothing: Set WdApp = Nothing: Set xlWs = Nothing
        Application.StatusBar = False

 

[Macropod]

The code for that is no more complicated than:

Sub SendInvRangeToWordDocument()
'Note: This code requires a VBA reference to be set to Word, via Tools|References.
Dim WdApp As New Word.Application, WdDoc As Word.Document
WdApp.Visible = False: Set WdDoc = WdApp.Documents.Add
ThisWorkbook.Worksheets("INV").Range("F4:N61").Copy: WdDoc.Range.Paste
WdDoc.SaveAs2 Filename:="C:\Users\" & Environ("UserName") & "\Documents\Filename.docx", _
  FileFormat:=wdFormatXMLDocument, AddToRecentFiles:=False
WdDoc.Close: WdApp.Quit: Set WdDoc = Nothing: Set WdApp = Nothing
End Sub