How can i save a sheet as a word document?

[tonywatsonhelp]

Hi Everyone,
I have a sheet that i current save as a PDF,
some have asked if there could have a Word copy,
the sheet is set up to be a few sheets and i currently get the Print Area from:

PrintArea
Sheets("Proposal").Range("EP99")

what i need is some VBA to create a word document of the sheet.
Please help if you can

Thanks

Tony


End Sub

 

[Joe4]

I have never heard of anyone trying to do anything like that.
More typical is to create a Mail Merge Document in Word with Excel as your data source, and to do a Mail Merge.
You can also try copy/pasting from Excel to Word, though the formatting won't be exactly the same.

 

[tonywatsonhelp]

I have been playing around with this idea for some weeks and can get the data into word but I cant get the word document to adjust the size of the columns so everythiing is fitting wrong?
Its driving me crazy as it not what I intended the document to be and its just some people who cant use excel want it in word.

I'll post my code below to see if anyone gets inspired by it, (I did before because I did want anyone to thing I wanted my code editing, I dont its just a guide)

Sub ToWord()
Dim ctr As Integer
Dim doc As Object 'Word.Document
Dim tbl As Object 'Word.Table
Dim sht As Excel.Worksheet

    Set doc = CreateObject("Word.Document") 'New Word.Document
    doc.Application.Visible = True
    
    ctr = 0

        On Error GoTo NoReport
        ActiveSheet.Range("EB101:EJ150").Copy 'this a small tempory range why i try sort out all the problems
        ctr = ctr + 1
        With doc.ActiveWindow.Selection
            If ctr > 1 Then
                .InsertBreak 7 'Word.wdPageBreak
            End If
            .PasteExcelTable True, False, False
        End With
NoReport:

 
'Below is the part im having a problem with, it just wont work???????
    For Each tbl In doc.Tables
        tbl.AutoFitBehavior 2 'Word.wdAutoFitWindow

        tbl.Rows.SetLeftIndent LeftIndent:=0, RulerStyle:= _
        wdAdjustNone

    tbl.Columns(2).SetWidth ColumnWidth:=15.35, RulerStyle:= _
        wdAdjustNone


    Next tbl
    
    

    
    
    MsgBox ctr & " Pages created."
    doc.Application.Activate
End Sub

 

[NdNoviceHlp]

Hi Tony. This code will copy pictures of XL page print ranges to separate Word doc pages. The code will size the XL range/pages/pics to fit separate Word doc pages. The module code requires a 32 bit installation. Change the code to reflect your sheet name, print ranges, and Word document path. HTH. Dave
Module code...

Public Declare Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function CloseClipboard Lib "user32" () As Long
Public Declare Function EmptyClipboard Lib "user32" () As Long

Wherever code...

Sub SaveXlRangeToWordFile2()
Dim WidthAvail As Double, ARR() As Variant
Dim WdDoc As Object, WdApp As Object, Cnt As Integer, Cnter As Integer
Dim Prng1 As Range, Prng2 As Range, Prng3 As Range
'set page print ranges
With Sheets("sheet1")
Set Prng1 = .Range(.Cells(1, "A"), .Cells(47, "I"))
Set Prng2 = .Range(.Cells(1, "J"), .Cells(47, "R"))
Set Prng3 = .Range(.Cells(1, "S"), .Cells(47, "AA"))
End With
'make array of print ranges
ARR = Array(Prng1, Prng2, Prng3)

'open Word application
On Error Resume Next
Set WdApp = GetObject(, "word.application")
If Err.Number <> 0 Then
On Error GoTo 0
Set WdApp = CreateObject("Word.Application")
End If
On Error GoTo erfix
'open doc **********change file path to suit
Set WdDoc = WdApp.Documents.Open(Filename:="C:\yourfoldername\bart.docx")
'clear doc
With WdApp.ActiveDocument
    .Range(0, .Characters.Count).Delete
End With
'determine width
With WdApp.ActiveDocument.PageSetup
    WidthAvail = .PageWidth - .LeftMargin - .RightMargin - .Gutter
End With
'loop print ranges
For Cnter = LBound(ARR) To UBound(ARR)
Cnt = Cnt + 1
ARR(Cnter).Copy
WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range.PasteSpecial DataType:=3 '9  '4
'size range pic to sheet
With WdDoc.Shapes(Cnt)
.LockAspectRatio = msoFalse
.Width = WidthAvail
End With
Application.CutCopyMode = False
OpenClipboard (0&)
EmptyClipboard
CloseClipboard
'paste to seperate page
WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range.InsertParagraphAfter
With WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range
.InsertParagraphAfter
.Collapse Direction:=0 'wdCollapseEnd
.InsertBreak Type:=7 'wdPageBreak
End With
Next Cnter
'clean up
WdApp.ActiveDocument.Close SaveChanges:=True
Set WdDoc = Nothing
WdApp.Quit
Set WdApp = Nothing
Exit Sub

erfix:
On Error GoTo 0
MsgBox "Save SaveXlRangeToWordFile error"
WdApp.ActiveDocument.Close SaveChanges:=False
Set WdDoc = Nothing
WdApp.Quit
Set WdApp = Nothing
Application.CutCopyMode = False
End Sub

 

[tonywatsonhelp]

Hi Dave,
Thanks very much for your Idea,
Is not exactly what i wanted as pictures cant be edited, however I think its the best we are going to get, so i'll use this and tell everyone its this or nothing
Thanks for your help
Tony

 

[NdNoviceHlp]

You are welcome. Thanks for posting your outcome. Dave