[AccessD] Writing raw RTF document using VBA

Tom Keatley tomk at multiline.com.au
Thu Oct 30 16:35:17 CST 2003


 
> The client has got new budgets and is again asking for this:
> 
> > My simple need (which I never got solved) was how to assemble an
> > rtf-formatted field from many records (essentially each an rtf
> > document) into one rtf document, stripping headers etc. from each
> > record and adding a header etc. to the final document.
> 
> Does anybody have a clue how to attack it?

Gustav..

I use rtf in one of my projects in the way you describe and although my method is very clunky .... it works and has been for some years now .....If you discover a cleaner/less clunky way I for one would be very interested in hearing about it 

My project is still using A97 and the biggest problem I found was the fact that the RTFocx will not bind directly to a table field or query so I had to use the control unbound and feed it from an rtf file on the hard drive .....whether this has changed in A2000 or A2002 I dont know   

Hmm...the pasted text below (looks crap in my email client) is produced by the function below it ....the result is saved as an rtf text file and then fed to the rtf OCX at runtime. 

Setting it up is failrly simple ....simply set up a document the way you would like to see it in wordpad (or any rtf editor) and then nip the rtf codes from the raw rext and wrap those around a variable in the function. the result of the rtf is below and then below that is the rtf code itself. Take RTFCODESTART from the start and then save as an rtf document to open in wordpad or similar. The last line (you will see it as 4) is a font I have built with the rating symbols we use and 4 happens to correspond to "M"rating (mature audience). 

I wrote this very early in my (ahem!) development and I think if I was to write it now I would use case statements instead of if then else's and also store the rtf codes in a table. Then I would use a find replace function so that I could vary the text produced (similar to the way early word processors used to work to acheive bold text etc with tags) eg <@BOLD@>I want this to be bold<@/BOLD@> 

I seem to remember you and I discussing this a few years ago Gustav.....
Hope it helps 

Regards

Tom Keatley 

RTF DISPLAYED (if you have your client set to plain text you wont see it)=================================================
About This Movie

Actors...

Jim Carrey, Justin Cooper, Maura Tierney, Jennifer Tilly

Producer ..

Brian Grazer

Director ..

Tom Shadyac

Writer ..

Paul Guay, Stephen Mazur

Editor ..

Don Zimmerman

Running Time ..

Approx 87 Mins

Production Year ..

1997


4

RAW RTF CODE============================================================

RTFCODESTART{\rtf1\ansi\ansicpg1252\deff0\deflang1033{\fonttbl{\f0\froman Arial Rounded MT Bold;}{\f1\froman Arial;}{\f2\froman MOVIE Ratings;}{\f3\froman Times New Roman;}}
{\colortbl ;\red255\green0\blue128;\red0\green0\blue255;}
\viewkind4\uc1\pard\ri150\cf1\ul\b\f0\fs22 About This Movie\cf0\ulnone\b0\fs18 
\par \pard\ri150\tx1440\tx6464\cf2 Actors...\cf0\fs24 
\par \pard\ri150\f1\fs16 Jim Carrey, Justin Cooper, Maura Tierney, Jennifer Tilly
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Producer ..\cf0\fs24 
\par \pard\ri150\f1\fs16 Brian Grazer
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Director ..\cf0\fs24 
\par \pard\ri150\f1\fs16 Tom Shadyac
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Writer ..\cf0\fs24 
\par \pard\ri150\f1\fs16 Paul Guay, Stephen Mazur
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Editor ..\cf0\fs24 
\par \pard\ri150\f1\fs16 Don Zimmerman
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Running Time ..\cf0\fs24 
\par \pard\ri150\f1\fs16 Approx 87 Mins
\par \pard\ri150\tx1440\tx6464\cf2\f0\fs18 Production Year ..\cf0\fs24 
\par \pard\ri150\f1\fs16 1997
\par \cf2\f0\fs18     \cf0\fs24 
\par \f2\fs72 4\f3\fs36 
\par }

FUNCTION==========================================

Function xstory(Tit, stry, act, time, rat, prod, dirx, spce, prco, wrt, edt, tht As Variant)
Dim tit2 As String, stry2 As String, time2 As String, act2 As String, rat2 As String, prod2 As String, dir2 As String, spc2 As String, prco2 As String, wrt2 As String, edt2 As String, tht2 As String
Dim lin1 As String
Dim Fac1 As String
Dim Fac2 As String
Dim Fac3 As String
Dim Fac4 As String
Dim linend1 As String


Fac1 = "\par \pard\ri150\tx1440\tx6464\plain\f5\fs18\cf2 "
Fac2 = "\plain\f5\fs24" & vbCrLf
Fac3 = "\par \pard\ri150\plain\f4\fs16 "
Fac4 = "" & vbCrLf

lin1 = "{\rtf1\ansi\ansicpg1252\deff0\deftab720{\fonttbl{\f0\fswiss MS Sans Serif;}{\f1\fdecor\fcharset2 Symbol;}{\f2\froman MOVIE Ratings;}{\f3\froman Times New Roman;}{\f4\froman Arial;}{\f5\froman Arial Rounded MT Bold;}{\f6\froman Times New Roman;}}" & vbNewLine _
& "{\colortbl\red0\green0\blue0;\red255\green0\blue128;\red0\green0\blue255;}" & vbNewLine _
& "\deflang1033\pard\ri150\plain\f5\fs22\cf1\b\ul About This Movie\plain\f5\fs18" & vbNewLine


linend1 = "\par \plain\f5\fs18\cf2     \plain\f5\fs24" & "\par \plain\f2\fs72 " & rat & "\plain\f6\fs36" & vbNewLine & "\par }"

If Nz(act, "") = "" Then
Else
act2 = "\par \pard\ri150\tx1440\tx6464\plain\f5\fs18\cf2 Actors...\plain\f5\fs24" & vbCrLf & "\par \pard\ri150\plain\f4\fs16 " & act & vbNewLine
End If

If Nz(time, "") = "" Then
Else
time2 = Fac1 & "Running Time .." & Fac2 & vbCrLf & Fac3 & time & Fac4 & vbCrLf  '\par \plain\f4\fs16 " & time & "\plain\f4\fs24" & vbcrlf
End If

If Nz(prod, "") = "" Then
Else
prod2 = Fac1 & "Producer .." & Fac2 & vbCrLf & Fac3 & prod & Fac4 & vbCrLf
End If

If Nz(dirx, "") = "" Then
Else
dir2 = Fac1 & "Director .." & Fac2 & vbCrLf & Fac3 & dirx & Fac4 & vbCrLf
End If

If Nz(spce, "") = "" Then
Else
spc2 = Fac1 & "Special Effects .." & Fac2 & vbCrLf & Fac3 & spce & Fac4 & vbCrLf
End If

If Nz(prco, "") = "" Then
Else
prco2 = Fac1 & "Production .." & Fac2 & vbCrLf & Fac3 & prco & Fac4 & vbCrLf
End If

If Nz(wrt, "") = "" Then
Else
wrt2 = Fac1 & "Writer .." & Fac2 & vbCrLf & Fac3 & wrt & Fac4 & vbCrLf
End If

If Nz(edt, "") = "" Then
Else
edt2 = Fac1 & "Editor .." & Fac2 & vbCrLf & Fac3 & edt & Fac4 & vbCrLf
End If

If Nz(tht, "") = "" Then
Else
tht2 = Fac1 & "Production Year .." & Fac2 & Fac3 & tht & Fac4 & vbCrLf
End If

xstory = lin1 & act2 & prod2 & dir2 & spc2 & prco2 & wrt2 & edt2 & time2 & tht2 & linend1
End Function


More information about the AccessD mailing list