Creating and filling a word document from excel VBA

R

rob poyck

Hello,

I'm creating a program in VBA of excel.
Now I have to make a raport function in the excel sheet.
So I have to Create a new word document and fill it, using the excel
VBA.
But I can't seem to find the right code to do this.
Can anyone here help me out?

Rob

*** Sent via Developersdex http://www.developersdex.com ***
 
P

paul.robinson

Hi
This is an unedited sub you can read. The excel text to go into the
letter is in a range called MyParagraphs.
See if it helps anyway!
regards
Paul

'Called by Make_Audit_Report to create a Word Document of Bullet
Points
'BulletCriteria is a Variant array of Booleans
Public Sub Make_The_Bullet_Point_Word_Document(BulletCriteria As
Variant, AuditReportName As String, DoctorName As Variant, AuditDate
As Variant, AuditDirectory As String)
Dim wrdApp As Word.Application
Dim WordWasRunning As Boolean
Dim ReportDoc As Word.Document
Dim BulletPoints As Variant, BulletCount As Integer
Dim FullName As String
Dim myParagraphs As Variant 'Text in "Bullet Point Criteria" sheet of
Methadone workbook
Dim k As Integer
Application.ScreenUpdating = False
'If Word is open, flag it and close Audit Report if it is open
On Error Resume Next
Err.Clear
Set wrdApp = GetObject(, "Word.Application") 'If Word is
already open, flag it with Boolean
If Err.Number <> 0 Then WordWasRunning = False Else
WordWasRunning = True
Err.Clear
'Close Word Audit Report File file with same name if it is
already open
FullName = "Audit Report for " & AuditReportName & ".doc"
Application.DisplayAlerts = False
wrdApp.Documents(FullName).Close
Application.DisplayAlerts = True
On Error GoTo 0
'Otherwise, open up Word
If Not WordWasRunning Then
Set wrdApp = New Word.Application 'fresh version of Word
End If
wrdApp.Visible = True
Set ReportDoc = wrdApp.Documents.Add
BulletPoints = ThisWorkbook.Worksheets("Bullet Point
Criteria").Range("BulletPoints").Value
With ReportDoc
.Activate
'Put in date, ref and introductory paragraph
.Content.InsertAfter Format(Date, "d-mmm-yy")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Doctor:" & vbTab & CStr(DoctorName)
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Re:" & vbTab & "Drug Misuse -
Methadone Treatment"
.Content.InsertParagraphAfter
.Content.InsertAfter vbTab & "Audit Report Period " &
Format(DateValue(AuditDate) - 28, "d-mmm-yy") & " to " &
Format(DateValue(AuditDate), "d-mmm-yy")
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Dear Doctor"
'insert some blurb
myParagraphs = ThisWorkbook.Worksheets("Bullet Point
Criteria").Range("Letter_Paragraphs").Value
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(1, 1) 'Thank you ...
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(2, 1) 'I wish...
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(3, 1) 'Enclosed is...
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
'Count the bullet points and insert into document if 1 or more
BulletCount = 0
For k = 1 To UBound(BulletCriteria)
If BulletCriteria(k) Then BulletCount = BulletCount + 1
Next k
If BulletCount <> 0 Then 'put in bullet points
.Content.InsertAfter myParagraphs(4, 1) 'There were...
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
For k = 1 To UBound(BulletCriteria)
If BulletCriteria(k) Then
.Content.InsertAfter BulletPoints(k, 1)
.Content.InsertParagraphAfter
End If
Next k
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(5, 1) &
Application.VLookup(CStr(DoctorName), ThisWorkbook.Worksheets("Doctors
Details").Range("DoctorsDetails"), 6, False) & myParagraphs(6, 1)
.Content.InsertParagraphAfter
End If
.Content.InsertAfter myParagraphs(7, 1) 'As you are aware
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter "Yours Sincerely"
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(8, 1)
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(9, 1)
.Content.InsertParagraphAfter
.Content.InsertAfter myParagraphs(10, 1)
'bold Re: lines and last two paragraphs
.Range(.Paragraphs(5).Range.Start, .Paragraphs(6).Range.End).Font.Bold
= True
.Range(.Paragraphs(.Paragraphs.Count -
1).Range.Start, .Paragraphs(.Paragraphs.Count).Range.End).Font.Bold =
True
'Bullet the Bullet points
On Error Resume Next 'gives an unexpected error sometimes!
If BulletCount <> 0 Then
.Range(.Paragraphs(16).Range.Start, .Paragraphs(16 +
BulletCount).Range.End).ListFormat.ApplyListTemplate
ListTemplate:=ListGalleries(wdBulletGallery).ListTemplates(1),
ContinuePreviousList:=False, ApplyTo:=wdListApplyToWholeList
End If
On Error GoTo 0
'Save file
'Error generated by Kill if MyNewWordDoc is open, but it is
closed above
If Dir(AuditDirectory & "\" & FullName) <> "" Then
Kill AuditDirectory & "\" & FullName
End If
.SaveAs (AuditDirectory & "\" & FullName)
If WordWasRunning = False Then .Close ' close the document if
Word was originally not running
End With
If WordWasRunning = False Then wrdApp.Quit ' close the Word
application if it wasn't open already

Set ReportDoc = Nothing
Set wrdApp = Nothing
End Sub
 
M

Mike H.

If I try to run one of the functions your link references or if I try to
execute the macro Paul posted, I get the same error message on the line:

Dim wrdApp As Word.Application

The error is: Compile Error. User-defined type not defined.

I get it that I have to define the type, but I am unsure how to do that.
Ideas?
 
P

paul.robinson

Hi
I just gave you code to look at and see how things are done. I didn't
expect you to try and run it.
It includes segments on opening Word, creating a document, inserting
text, saving the document and so on. Have a read through it and work
out what the bits do.
regards
Paul
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Top