Lebans RTF2 Control Default Font Microsoft Access 2003

[jpkemp]

I have an application that used to use the Microsoft RTF box. I learned
over Easter they no longer support it in Access 2003. Luckily I was
already using the Lebans Control for Printing, so I substituted this for
the Microsoft Control.

However, I have had no luck whatsoever in:
1. Changing the default font for the RTF2 Box.
2. Changing the default txt Font with VBA programming for data already
entered.

I tried every combination of the post to Michael Gould that used the fnt
and set x.font=fnt method. Does this only work on selected text?

I am moving information from thousands of records from standard memo
fields that were entered using text boxes into memo fields bound to a text
box. What I do is modify the string, replacing the line feeds and tab
setting with the \tab and \par commands. Then I move it into a RTF2 box on
a form then into memo field. No matter what I do, I still get the fswiss
font. Any help would be greatly appreciated.

Incidentally, the Visual Studio Tools for Office 2003 (the new Office
Developer) no longer allows the installation of any ActiveX controls with
the runtime version. Luckily the support people at Microsoft showed me how
to chain a 'dummy' install of 2002 that put the ActiveX controls into my
app after the normal 2003 install.

 

[Guest]

H
I've had the same problem
Microsoft France advised me to use the WebBrowser control instead of RTF
It uses HTML encoding, which might be supported for many year
The bigest problem is to convert rtf to html
In a 2002 database, I made a routine that does it pretty well
(I give you most of the necessary code, except for some APIs : If you can't find them, just ask
Hope that'll help yo
Jean-Baptiste Lecui

Sub RtfToHtml(
Dim Hdoc As IHTMLDocument, HoleRng As IHTMLTxtRang

With [The form containing both RTFcontrol and WebBrowser [WB] controls

If Nz(![RTFcontrol]) <> 0 The
CopyRTF (![RTFcontrol]
Set Hdoc = !WB.Documen
GoSub BrowserUpdat
Els
!WB.Document.body.innerHTML = vbNullStrin
End If
End Wit

Set Hdoc = Nothin
Set HoleRng = Nothin
Exit Su
BrowserUpdate

Hdoc.body.innerHTML = vbNullStrin
Set HoleRng = Hdoc.body.createTextRang
HoleRng.Selec
Hdoc.execCommand "Paste", False, Tru
Retur
End Su

Sub CopyRTF(Ctrl As Control
Static oWord As Objec
Static oTmpDoc As Objec

On Error Resume Nex

If oWord Is Nothing Then Set oWord = CreateObject("Word.Application"
If oTmpDoc Is Nothing Then Set oTmpDoc = oWord.Documents.ad
oWord.Visible = Tru

With Ctr
.SelStart =
.SelLength = Len(.TextRTF
ClipBoard_SetDataRTF .SelRT
.SelLength =
End Wit

With oTmpDo
.ActiveWindow.Selection.wholestor
.ActiveWindow.Selection = vbNullStrin
.content.Past

With .ActiveWindow.Selectio
.wholestor
.End = .End - 1 'pour enlever la marque de paragraphe final
.Cop
End Wit
End Wit

End Su

Function ClipBoard_SetDataRTF(sRTF As String
'Copy the contents of the Rich Text to the clipboar

Dim lSuccess As Lon
Dim lRTF As Lon
Dim hGlobal As Lon
Dim lpString As Lon

lSuccess = OpenClipboard(0&) '(Me.hwnd
lRTF = RegisterClipboardFormat("Rich Text Format"
lSuccess = EmptyClipboar
hGlobal = GlobalAlloc(GMEM_MOVEABLE Or GMEM_DDESHARE, Len(sRTF)
lpString = GlobalLock(hGlobal

CopyMemory lpString, ByVal sRTF, Len(sRTF
GlobalUnlock hGloba
SetClipboardData lRTF, hGloba
CloseClipboar
GlobalFree hGloba
End Function

 

[Guest]

I forgot to tell you
I you use a RTF editor, you'll have to build a HTML editor
Ask me if you need clue
JB

 

[Stephen Lebans]

There's a mini HTML editor here:
http://www.lebans.com/htmleditor.htm

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

 

[Guest]

You've done a very good and useful job : I used it in my own database (thanks
I just added a few possibilities

WB.Document.execCommand "JustifyFull
WB.Document.execCommand "Undo
WB.Document.execCommand "Redo

Private Sub Highlight(Color As String
Dim txtRng As IHTMLTxtRange, strHTML As Strin
' color = yellow, or fuchsia, or aqua, or lime, aso.
strHTML = "<SPAN style=" & chr(34) & "BACKGROUND: " & color & "; mso-highlight: " & color & chr(34) & ">
Set txtRng = WB.Document.Selection.createRang
strHTML = strHTML & txtRng.HTMLText & "</SPAN>
txtRng.pasteHTML strHTM
End Su

Jean-Baptiste Lecuit

 

[jpkemp]

Thanks, but I'm pretty much committed to RTF at this point and need to
change the default font.

I understand Stephen is going to add a default font property in the
future, but for now I need to know what to do. I must be doing something
wrong in setting up the default, but I can't seem to get it to work no
matter where I put the recommended solution.

 

[Stephen Lebans]

That's great Jean. If you don't mind I will add your mods to my HTML
Editor.


--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

You've done a very good and useful job : I used it in my own database (thanks)
I just added a few possibilities :

WB.Document.execCommand "JustifyFull"
WB.Document.execCommand "Undo"
WB.Document.execCommand "Redo"

Private Sub Highlight(Color As String)
Dim txtRng As IHTMLTxtRange, strHTML As String
' color = yellow, or fuchsia, or aqua, or lime, aso..
strHTML = "<SPAN style=" & chr(34) & "BACKGROUND: " & color & ";

mso-highlight: " & color & chr(34) & ">"

 

[Stephen Lebans]

Post the code and which event you are using it from.

--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

 

[jpkemp]

Stephen,
I'm committed to using your RTF2 control and not moving to an HTML
solution. I've looked at the code that is supposed to select the default
font of the box, and have tried to modify the text currently in the box,
to no avail. It may be that I have to select text first or have placed
things in the wrong sequence.

This is the code behind my button that corrects the non RTF code with RTF
tags. My problem is that I can't manage to get it to do anything other
than the system font, which when brought up in Word shows up as long thin
lines. If the lines are highlighted and the font changed, there isn't a
problem.

Thanks for your help with this.

The code selects memo field contents (summary) that are missing RTF
coding. It blots out the RTF label or that shows up in the first record.
It then puts in the required tabs and paragraph markers and drops it into
the RTF box. This puts the code in and then it's stored back in the memo
field. It loops through the recordset until all screwed up memo fields
have RTF coding on them.

Private Sub Command0_Click()
On Error GoTo p_err
DoCmd.Hourglass True
Application.Echo False
x = 1
crit = "SELECT CLIENTSW.CASENUM, CLIENTSW.SUMMARY FROM CLIENTSW WHERE
(((CLIENTSW.SUMMARY) Not Like ""*rtf*"" And (CLIENTSW.SUMMARY) Is Not
Null));"
Set mdb = CurrentDb()
Set mrs = mdb.OpenRecordset(crit, dbOpenDynaset, dbSeeChanges)
If mrs.EOF And mrs.BOF Then
Else
Dim xz As String
'Font Setting

'Experiment with Font
Me!SUMMARY.rtfText = ""
'Loop through the records
mrs.MoveFirst
Do While Not mrs.EOF And x < 3000
'Replace the new lines and tabs
xz = mrs!SUMMARY
xz = Replace(xz, vbNewLine, "\par ")
xz = Replace(xz, vbTab, "\tab ")
'Change to RTF text
Me!SUMMARY.Object.SelText = xz
Set txtRTF = Me.SUMMARY.Object
'Update the Summary field
mrs.Edit
mrs!SUMMARY.Value = txtRTF.rtfText
txtRTF.rtfText = ""
mrs.Update
mrs.MoveNext
x = x + 1
Loop
mrs.Close
Set mrs = Nothing
Set mdb = Nothing
End If
DoCmd.Hourglass False
Application.Echo True
MsgBox x
Exit Sub
p_err:
Application.Echo True
MsgBox Err.Description
End Sub

 

[Guest]

Hi Stephen
Of course I don't min
You could also add the following

WB.Document.execCommand "CreateLink

Private Sub Navigate(NavigationMode as Boolean
WB.Document.DesignMode = IIf(NavigationMode , "Off", "On"
'Add code to Enable/disable Editing button
End Sub

Jean-Baptiste Lecuit

 

[Guest]

If you add the "Navigation" routin
Also add this
Private Sub WBt_BeforeNavigate2(ByVal pDisp As Object, URL As Variant, flags As Variant, TargetFrameName As Variant, PostData As Variant, Headers As Variant, Cancel As Boolean
If URL = "about:blank" The
Exit Sub 'Otherwise : error when initializing browse
Els
Cancel = Tru
WBcit.Navigate2 URL, , "Blank" 'IMPORTANT : to open in a New window (internet explorer
End I
End Sub

 

[jpkemp]

Stephen,
I'm committed to using your RTF2 control and not moving to an HTML
solution. I've looked at the code that is supposed to select the default
font of the box, and have tried to modify the text currently in the box,
to no avail. It may be that I have to select text first or have placed
things in the wrong sequence.

This is the code behind my button that corrects the non RTF code with RTF
tags. My problem is that I can't manage to get it to do anything other
than the system font, which when brought up in Word shows up as long thin
lines. If the lines are highlighted and the font changed, there isn't a
problem.

Thanks for your help with this.

The code selects memo field contents (summary) that are missing RTF
coding. It blots out the RTF label or that shows up in the first record.
It then puts in the required tabs and paragraph markers and drops it into
the RTF box. This puts the code in and then it's stored back in the memo
field. It loops through the recordset until all screwed up memo fields
have RTF coding on them.

Private Sub Command0_Click()
On Error GoTo p_err
DoCmd.Hourglass True
Application.Echo False
x = 1
crit = "SELECT CLIENTSW.CASENUM, CLIENTSW.SUMMARY FROM CLIENTSW WHERE
(((CLIENTSW.SUMMARY) Not Like ""*rtf*"" And (CLIENTSW.SUMMARY) Is Not
Null));"
Set mdb = CurrentDb()
Set mrs = mdb.OpenRecordset(crit, dbOpenDynaset, DbSeeChanges)
If mrs.EOF And mrs.BOF Then
Else
Dim xz As String
Me!SUMMARY.rtfText = ""
'Loop through the records
mrs.MoveFirst
Do While Not mrs.EOF And x < 3000
'Replace the new lines and tabs
xz = mrs!SUMMARY
xz = Replace(xz, vbNewLine, "\par ")
xz = Replace(xz, vbTab, "\tab ")
'Change to RTF text
Me!SUMMARY.Object.SelText = xz
Set txtRTF = Me.SUMMARY.Object
'Update the Summary field
mrs.Edit
mrs!SUMMARY.Value = txtRTF.rtfText
txtRTF.rtfText = ""
mrs.Update
mrs.MoveNext
x = x + 1
Loop
mrs.Close
Set mrs = Nothing
Set mdb = Nothing
End If
DoCmd.Hourglass False
Application.Echo True
MsgBox x
Exit Sub
p_err:
Application.Echo True
MsgBox Err.Description
End Sub

 

[Stephen Lebans]

I haven't forgotten about you!

Tonight I posted a new version of the RTF control, version 1.8. I've
added several new props, most notably SelFontName, SelFontSize and a
Default Font property that actually works.<grin>.

The simplest way for you to set all of your exisiting text in the RTF
control to a specific font is to do something like:
Open the recordset
Loop through all of the existing records
rst.Edit
Rtf.SelStart = 0
RTF.SelLength = 65000
RTF.SelFontName = "Arial"
RTF.SelFontSize = 10
rst.Update
Loop

Set the Default font via the property sheet to whatever you want.
Remember this will effect the current record if you are in form view so
do it in Design view or be on a new record.

Let me know how you make out.


--

HTH
Stephen Lebans
http://www.lebans.com
Access Code, Tips and Tricks
Please respond only to the newsgroups so everyone can benefit.

 

[jpkemp]

Thank you for your unsung work.

I don't know if you heard, but when I learned about the fact that
Microsoft was not supporting their text box control anymore, one of the
solutions they recommended was your RTF2.

It's hard enough to put things out when you get paid, but it's much harder
when you do it pro bono.

Once again, thank you. I'll let you know if I run into any glitches.