Convert Excel Sheets to Word and Fit to Window

[sabbuck]

I have an excel workbook with 13 active sheets. I have a button to convert 5 of these sheets to word, which works fine (see code). I'm trying to get the word document to fit to window when the data is converted. And also if I can get the word document to be landscape. Both of these can be done manually of course, but I'm trying to avoid as much manual work as I can for the users of these documents. Any help is much appreciated.

Sub Open_Word_Document()
Dim wdApp As Word.Application, wdDoc As Word.Document, sh As Worksheet
Application.ScreenUpdating = False
Application.StatusBar = "Creating new document..."
Set wdApp = New Word.Application
Set wdDoc = wdApp.Documents.Add
For Each sh In ActiveWorkbook.Worksheets
  Select Case sh.Name
    Case Is = "Membership 1", "Product & Services 1", "Geographical 1", "Transaction 1", "Distribution 1"
    Application.StatusBar = "Copying data from " & sh.Name & "Sheets"
    sh.UsedRange.Copy
    wdDoc.Paragraphs(wdDoc.Paragraphs.Count).Range.Paste
    Application.CutCopyMode = False
  End Select
Next sh
Set sh = Nothing
Application.StatusBar = "Cleaning up..."
With wdApp.ActiveWindow
    If .View.SplitSpecial = wdPaneNone Then
        .ActivePane.View.Type = wdPrintView
    Else
        .View.Type = wdNormalView
    End If
End With
Set wdDoc = Nothing
wdApp.Visible = True
Set wdApp = Nothing
Application.StatusBar = False
End Sub

 

[NdNoviceHlp]

Hi sabbuck. Maybe you can trial/adapt this bit of code to your needs. Not sure about the landscape needs. HTH. Dave

'determine width
With WdApp.ActiveDocument.PageSetup
    WidthAvail = .PageWidth - .LeftMargin - .RightMargin
End With
'loop sheets
For Each Ws In ActiveWorkbook.Worksheets
Cnt = Cnt + 1
Application.StatusBar = "Copying data from " & Ws.Name & "..."
Ws.UsedRange.Copy
WdDoc.Paragraphs(WdDoc.Paragraphs.Count).Range.PasteSpecial DataType:=3 '9  '4
'size range to sheet
With WdDoc.Shapes(Cnt)
.LockAspectRatio = msoFalse
.Width = WidthAvail
End With