Excel Range fit to Word Doc Page VBA help Please.

[newbee2]

Sorry to repost,
Having a bit of aporplexy with this problem in VBA.
I can get a Range to copy to clipboard.(The range is bigger than an A4 sheet)

Case Is = 8
Rem MsgBox "it works", vbOKOnly
Set rng7 = Sheet1.Range("A130:G154&quot
Sheets(1).Range("A130:G154&quot.Copy
WordStart

I can get the word doc to save from the template called up minus the Range (Somehow the Range stays on the clip board). If I open the Saved doc I can get the Range to paste manually.
But I can't get the Range to paste or for the screen view to show using VBA.
Can someone Please assist to get the Range to fit to page and the word session to show.

Sub WordStart()
On Error Resume Next
'create a word instance to use for the Table

Dim objWord As Object
Dim objDocs As Object
Dim strShortDate As String
Dim strDoc As String
Dim strDocsPath As String
Dim strSaveName As String
Dim strSaveNamePath As String
Dim strTemplatePath As String
Dim strtest As String
Dim strtestfile As String
Dim strwordtemplate As String
Dim strmessagetitle As String
Dim strmessage As String
Dim blnSaveNameFail As Boolean

Set objWord = CreateObject("Word.Application&quot

'the paths for templates and documents are hard coded.
'and are picked up from the file locations page of the
'Word Options dialog box.

strTemplatePath = objWord.Options.DefaultFilePath(wdUserTemplatesPath) & "\"
strwordtemplate = strTemplatePath & "SalesData.dot"
strDocsPath = "C:\My Documents\Test\"
Debug.Print "Docs path: " & strDocsPath

'this date string is used in creating the letter save name.
strShortDate = Format(Date, "dd-MMM-yyyy&quot

'check for existance of template in folder
'exit if not found

strtestfile = Nz(Dir(strwordtemplate))
If strtestfile = "" Then
MsgBox strwordtemplate & " template not found; can't create Chart."
Exit Sub
End If

Set objDocs = objWord.Documents
objDocs.Add strwordtemplate
strCompanyName = "Nu-Con"

'check for existance of previously saved letter in document folder
'and append an incremental number to save name if found

strSaveName = "Chart" & strCompanyName & "SalesData" & strShortDate & ".doc"

intCount = 2
blnSaveNameFail = True
Do While blnSaveNameFail
strSaveNamePath = strDocsPath & strSaveName
Debug.Print "Proposed save name and Path:" _
& vbCrLf & strSaveNamePath
strtestfile = Nz(Dir(strSaveNamePath))
If strtestfile = strSaveName Then

'create new save name with incremental number
blnSaveNameFail = True
strSaveName = "Chart " & CStr(intCount) & " For " & strCompanyName _
& " Sales " & strShortDate & ".doc"

strSaveNamePath = strDocsPath & strSaveName
intCount = intCount + 1
Else
blnSaveNameFail = False
End If
Loop

'Ask whether user wants to save the document

strmessagetitle = "Save Document"
strmessage = "Save this document as " & strSaveName
intReturn = MsgBox(strmessage, vbYesNoCancel + _
vbQuestion + vbDefaultButton1, strmessagetitle)

If intReturn = vbNo Then
objWord.ActiveDocument.Close SaveChanges:=wdDoNotSaveChanges
GoTo WordstartExit

ElseIf intReturn = vbYes Then
objWord.ActiveDocument.SaveAs strSaveNamePath
ElseIf intReturn = vbCancel Then
GoTo WordstartExit
End If

'notify user we are done
MsgBox "SalesData Chart complete.", vbMsgBoxSetForeground
With objDocs.Selection
.Wholestory
.EndKey unit:=wdStory
.Orientation = wdorientportrait
.Zoom = False
.FitToPagesTall = 1
.FitToPagesWide = 1
'Paste Range
.Paste
.ActiveWindow.WindowState = wdwindowstatenormal
.Visible = True
End With

'release object Variable
Set objWord = Nothing

WordstartExit:
'Close any open recordset or database, in case code stops
'because of an error.
On Error Resume Next
objWord.Quit
Set objWord = Nothing

Regards
Bill