Tek-Tips is the largest IT community on the Internet today!

Members share and learn making Tek-Tips Forums the best source of peer-reviewed technical information on the Internet!

  • Congratulations SkipVought on being selected by the Tek-Tips community for having the most helpful posts in the forums last week. Way to Go!

Repost , Excel range to word Doc woes - Guidance please

Status
Not open for further replies.

newbee2

Technical User
Apr 21, 2002
85
0
0
Hi,
Please give me some guidance. i'm not really a VBA person so any attempt I make is a stab in the dark intil it works.
Things have changed somewhat since the last time I posted.
Well I can get the Range to copy to clip board,I can get the template to save as a doc minus the Range. But I acn't get word to open or the Range to paste to the Document, to fit the page.
Using Office 2000.
And the word 9 object library is referenced.
Here is the code to date.
Case Is = 8
Rem MsgBox "it works", vbOKOnly
Set rng7 = Sheet1.Range("A130:G154")
Sheets(1).Range("A130:G154").Copy
WordStart

Sub WordStart()
'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")

'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 = "C:\My Documents" & "\"
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")

'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 objWord.Selection
.EndKey Unit:=wdStory
'Paste Range
.Paste
End With
objWord.Documents.Open strSaveNamePath

'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

End Sub


So I hope someone can help.
Thanks in advance
Bill
 
Status
Not open for further replies.

Part and Inventory Search

Sponsor

Back
Top