Hi everyone. I hope I can get some insight here.
Using Office 97/Win 2k Pro and Office 2003/Win XP Pro, same results.
I have a workbook that creates a Word document using a command button and userform. The command button calls the user form, data is entered by the user, and when a command button on the user form is clicked, the document is generated.
Sometimes, I can step through the procedure, and it will work all the way through. Sometimes, it seems as if I step through too fast, the procedure seems to just stop without warning, and will not go any further. If I try to run the procedure by simply clicking the command button, it will never run all the way through.
The procedure that is generating the Word document is as follows:
Sub CreateSampleRequestLetter()
Dim wrdApp As Word.Application
Dim wrdDoc As Word.Document
Dim wrdTmp As Word.Document
Dim rng As Word.Range
Dim strTemp As String
Dim Ans
Application.ScreenUpdating = False
Set wrdApp = CreateObject("Word.Application")
Set wrdDoc = wrdApp.Documents.Open _
("http://*****.doc")
Set wrdTmp = wrdApp.Documents.Open _
("http://*****.dot")
Sometimes it will stop within this With statement:
With wrdDoc.PageSetup
.DifferentFirstPageHeaderFooter = True
.LeftMargin = InchesToPoints(1)
.RightMargin = InchesToPoints(1)
.TopMargin = InchesToPoints(1)
.BottomMargin = InchesToPoints(1)
.FirstPageTray = wdPrinterManualFeed
.OtherPagesTray = wdPrinterManualFeed
End With
Sometimes it will stop within this With statement:
With wrdDoc.Sections(1)
.Headers(wdHeaderFooterFirstPage).Range.Delete
.Headers(wdHeaderFooterPrimary).Range.Delete
.Footers(wdHeaderFooterFirstPage).Range.Delete
.Footers(wdHeaderFooterPrimary).Range.Delete
End With
Set rng = wrdTmp.Sections(1).Headers(wdHeaderFooterFirstPage).Range
rng.Copy
With wrdDoc.Sections(1).Headers(wdHeaderFooterFirstPage)
.Range.Paste
.Shapes(1).IncrementLeft -30.75
End With
wrdTmp.Close False
Set rng = wrdDoc.Content
Sometimes it will stop while the document is being edited (at random points):
'Makes all applicable changes to the letter content, based on user form data.
With wrdApp.Selection
.WholeStory
.ParagraphFormat.RightIndent = InchesToPoints(0) 'remove right indent
With .Font 'correct font size and type
.Size = 10
.Name = "Palatino Linotype"
End With
.HomeKey wdStory
.MoveDown wdLine, 1, wdExtend 'delete exhibit name
.Delete wdCharacter, 1
.HomeKey wdStory
With .Find 'change indents for bulleted list
.Text = "UB ("
.Execute
End With
.HomeKey wdLine
.MoveDown wdLine, 7, wdExtend
.MoveRight wdCharacter, 1, wdExtend
With .ParagraphFormat
.TabStops(InchesToPoints(0.75)).Clear
.LeftIndent = InchesToPoints(0.5)
.RightIndent = InchesToPoints(0.25)
End With
.HomeKey wdStory
With .Find 'removes paragraph spacing on subj line
.Text = "SUBJECT"
.Execute
End With
.HomeKey wdLine
With .ParagraphFormat
.SpaceBefore = 0
.SpaceAfter = 0
End With
.HomeKey wdStory
With .Find 'delete extra line before subject
.Text = "subject"
.Execute
End With
.HomeKey wdLine
.TypeBackspace
.HomeKey wdStory
With .Find 'insert current date
.Text = "<Date>"
.Replacement.Text = Format(Date, "mmmm d, yyyy")
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert on-site review date & time
.Text = "<Date>"
.Replacement.Text = Format(frmSampleReqLetter.txtOnsiteDate, "mmmm d, yyyy")
.Execute Replace:=wdReplaceAll
End With
.HomeKey wdStory
With .Find
.Text = "<Time>"
.Replacement.Text = frmSampleReqLetter.cboOnsiteTime
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert contact name & title
.Text = "<Contact Name> <Contact Title>"
With frmSampleReqLetter
strTemp = .cboMrMs & .txtContName1 & " " & .txtContName2 & _
", " & .txtContTitle
End With
.Replacement.Text = strTemp
.Execute Replace:=wdReplaceOne
strTemp = ""
End With
.HomeKey wdStory
With .Find 'insert salutation
.Text = "Dear:"
.Replacement.Text = "Dear " & frmSampleReqLetter.cboMrMs & _
frmSampleReqLetter.txtContName2 & ":"
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert provider name
.Text = "<Facility Name>"
.Replacement.Text = frmSampleReqLetter.txtProvName
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find
.Text = "<Provider Name>"
.Replacement.Text = frmSampleReqLetter.txtProvName
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert provider number
.Text = "<Provider #>"
.Replacement.Text = frmSampleReqLetter.txtProvNo
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert provider address
.Text = "<Facility Address>"
.Replacement.Text = frmSampleReqLetter.txtAddress1
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find
.Text = "<Facility City, State, Zip Code>"
.Replacement.Text = frmSampleReqLetter.txtAddress2
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert intial letter date
.Text = "<Date of Initial Notification Letter>"
.Replacement.Text = Format(frmSampleReqLetter.txtInitLetter, "mmmm d, yyyy")
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert auditor phone number
.Text = "<Manager's Telephone Number>"
.Replacement.Text = frmSampleReqLetter.txtAudPhone
.Execute Replace:=wdReplaceOne
End With
.HomeKey wdStory
With .Find 'insert auditor name & title
.Text = "<Manager Name>"
With frmSampleReqLetter
strTemp = .txtAudName & Chr(13) & .txtAudTitle
End With
.Replacement.Text = Chr(13) & strTemp
.Execute Replace:=wdReplaceOne
strTemp = ""
End With
.HomeKey wdStory
With .Find 'remove PAD from signature line
.Text = "Provider Audit Department"
.Replacement.Text = ""
.Execute Replace:=wdReplaceOne
End With
.TypeBackspace
' If Answer = vbNo Then
' .EndKey wdStory
' .TypeBackspace
' .HomeKey wdStory
' With .Find 'insert auditor phone number
' .Text = frmSampleReqLetter.txtAudTitle
' .Execute
' End With
' .HomeKey wdLine
' .TypeBackspace
' .TypeText ", "
' End If
.HomeKey wdStory
End With
Application.ScreenUpdating = True
With wrdApp
.Visible = True
.Activate
End With
Dialogs(wdDialogFileSaveAs).Show
frmSampleReqLetter.Hide
End Sub
Thanks in advance for any input.
Jason
Bookmarks