|
|
 |
| Word VBA Discuss using VBA to program Word. |
Welcome to the p2p.wrox.com Forums.
You are currently viewing the Word VBA section of the Wrox p2p Programmer to Programmer discussion community. This is a community of more than 40,000 computer programmers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining our free Wrox p2p community you can post your own programming questions and respond to other programmers’ questions. Registered users also don't have to see the ads that are displayed to guests. Registration is fast, simple and absolutely free so please, join today!
Join today and post to win prizes! Post more to increase your chances of being Wrox’s top poster of the month.
|
 |

May 11th, 2009, 08:34 AM
|
|
Registered User
|
|
Join Date: May 2009
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
|
|
Excel to Word VBA
Hi guys,
I was hoping you could help me with something quickly. I have the following script:
Code:
Sub rejection()
' word document object creation
Dim WordApp As Object
Dim i As Integer, j As Integer, numRows As Integer
' show the actions that the macro is performing for now
Application.ScreenUpdating = False
' the submissions worksheet must be selected
Set Data = ActiveSheet.Range("A1")
numRows = ActiveSheet.UsedRange.Rows.Count
For i = 1 To numRows
' pull column for each row into dynamic strings
rejectType = Data.Offset(i - 1, 4).Value
authorString = Data.Offset(i - 1, 1).Value
insightsString = Data.Offset(i - 1, 6).Value
alternateJournalString = Data.Offset(i - 1, 5).Value
' if no value for field
If rejectType <> "quality" And rejectType <> "Subject" Then
GoTo Nextif
End If
If rejectType = "quality" And qualityRejectionTemplateFile = "" Then
MsgBox ("Please locate Quality-based rejection letter template file")
qualityRejectionTemplateFile = Application.GetOpenFilename
ElseIf rejectType = "Subject" And subjectRejectionTemplateFile = "" Then
MsgBox ("Please locate Subject-based rejection letter template file")
subjectRejectionTemplateFile = Application.GetOpenFilename
End If
' create rejection letter
Set WordApp = CreateObject("Word.Application")
With WordApp
Application.StatusBar = "Creating " & rejectType & "rejection letter from template"
.Visible = True
' should be .dot, a template file
' should be placed in the same directory as the excel file that this is being called from
If rejectType = "quality" Then
.Documents.Open qualityRejectionTemplateFile
ElseIf rejectType = "Subject" Then
.Documents.Open subjectRejectionTemplateFile
End If
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the name in the document
With .Selection.Find
.Text = "<Name>"
.Replacement.Text = authorString
.Wrap = wdFindStop
.Execute Replace:=wdReplaceAll
End With
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the Insights in the document
With .Selection.Find
.Text = "<insights>"
.Replacement.Text = insightsString
.Wrap = wdFindStop
End With
.Selection.Find.Execute Replace:=wdReplaceAll
' clear out find and replace fields
.Selection.Find.ClearFormatting
.Selection.Find.Replacement.ClearFormatting
' find and replace the Alternate Journal name in the document
With .Selection.Find
.Text = "<Alternate Journal>"
.Replacement.Text = alternateJournalString
End With
.Selection.Find.Execute Replace:=wdReplaceAll
' save document with appropriate name and close
.ActiveDocument.SaveAs Filename:=authorString & "_reject_" & rejectType & ".doc"
.ActiveWindow.Close
' Kill the object
.Quit
End With
Nextif:
Next i
End Sub
For the life of me, I cannot figure out why the Replacement.Text function doesn't work. When the macro is running, you can see it select <Name>, but it doesn't make any changes before it closes it and opens a new instance (It doesn't move on to <insights> or <alternate journal>)
Anyone have any ideas??
Thank you so much. I've learned a lot from these boards.
|

May 11th, 2009, 09:25 PM
|
|
Friend of Wrox
|
|
Join Date: Sep 2005
Location: , , .
Posts: 420
Thanks: 0
Thanked 14 Times in 14 Posts
|
|
Hi
Try changing the Wrap to wdFindContinue
With .Selection.Find
.Text = "<Name>"
.Replacement.Text = authorString
.Wrap = wdFindContinue
.Execute Replace:=wdReplaceAll
End With
Cheers
Shasur
|
| Thread Tools |
Search this Thread |
|
|
|
| Display Modes |
Linear Mode
|
Posting Rules
|
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts
HTML code is Off
|
|
|
|
 |