Fonts, Colors and so on!

[canuckbulldog]

I've been looking for this info but cannot seem to find it. I've found plenty on textbox, text and so on... But this problem, No Luck!

Here's the situation.

I'm using VB to gather info from an Excel file, then transfer it to Outlook... Basicly, I've built macros.

Question, How, in this process can I change the font and color of the displayed text in Outlook (inside the macro)?

Right now, it is all automatically displayed inside the Outlook window (just before you send it) in the default font. I would like to make some parts of it bold, blue and red. Plus change a few line's sizes.

Thank you!

Here's a sample of the code!

[CODE=vb]Sub Fournisseur()
Dim CCNom As String
Dim FourCode As String
Dim NumDem As String
Dim DtSout As String
Dim ClientMots As String
Dim AuteurNom As String
Dim AuteurTel As String
Dim NtsTrad As String
Dim FourCour As String
Dim Subj As String
Dim Msg As String
Dim URL As String
Dim Phone1 As String
Dim Phone2 As String
Dim Phone3 As String

' Accumuler les valeurs pour le courriel
CCNom = "default@email.c om"
NumDem = ActiveCell
DtSout = ActiveCell.Offs et(0, 9)
ClientMots = ActiveCell.Offs et(0, 16)
AuteurNom = ActiveCell.Offs et(0, 5)
AuteurTel = ActiveCell.Offs et(0, 6)
NtsTrad = ActiveCell.Offs et(0, 14)
FourCour = ActiveCell.Offs et(0, 35)

' Vérification de la personne ressource
If AuteurNom = "" Or AuteurNom = "SAME" Then
AuteurNom = ActiveCell.Offs et(0, 3)
End If

If AuteurTel = "" Then
AuteurTel = ActiveCell.Offs et(0, 4)
End If

' Ajustement du téléphone
Phone1 = Left(AuteurTel, 3)
Phone2 = Mid(AuteurTel, 4, 3)
Phone3 = Right(AuteurTel , 4)

' Texte pour la rubrique sujet
Subj = "Demande traduction / Translation Request " & "(" & NumDem & ")" & " ..." & "<" & DtSout & ">" & " ... " & ClientMots & " Mots / Words"
' Corps principale du courriel
Msg = ""
' Information

Msg = Msg & "Pour traduction / For translation:" & vbCrLf & vbCrLf
Msg = Msg & "Personne ressource / Contact ressource:" & vbCrLf
Msg = Msg & "Nom / Name : " & AuteurNom & vbCrLf
Msg = Msg & "Tél. / Tel. : " & "(" & Phone1 & ") " & Phone2 & "-" & Phone3 & vbCrLf & vbCrLf
Msg = Msg & "Notes pour le traducteur / Notes for the translator:" & vbCrLf
Msg = Msg & NtsTrad & vbCrLf & vbCrLf
Msg = Msg & "Document(s ) à traduire / Document(s) to translate:" & vbCrLf & vbCrLf
Msg = Msg & "Document(s ) de référence seulement / Reference document(s) only:" & vbCrLf & vbCrLf
Msg = Msg & "Gabarit à utiliser / Template to use:" & vbCrLf & vbCrLf

' Remplacer espace avec %20 (hex)
Subj = Application.Wor ksheetFunction. Substitute(Subj , " ", "%20")
Msg = Application.Wor ksheetFunction. Substitute(Msg, " ", "%20")

' Remplacer les retour de chariot avec %0D%0A (hex)
Msg = Application.Wor ksheetFunction. Substitute(Msg, vbCrLf, "%0D%0A")
' Crée l'URL
URL = "mailto:" & FourCour & "?subject=" & Subj & "&body=" & Msg & "&Cc=" & CCNom

' Éxécuter l'URL (démarer le programme de courriel électronique)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
End Sub[/CODE]