Mettre en gras une partie du texte dans un code VBA -
Bonjour tout le monde,
J'ai un peu honte... J'ai fait des recherches sur le forum et j'ai trouvé des questions similaires à la mienne mais comme je n'ai pas une compréhension parfaite, ni même avancée, du code VBA je n'arrive pas à adapter les solutions proposées à mon cas. :oops:
Voilà : j'envoie un mail directement depuis Excel, avec le corps du message inscrit dans le code VBA (que j'ai recopié d'un site internet et qui fonctionne très bien). Le hic, c'est que je dois mettre en gras certains groupes de mots placés entre " ". J'ai essayé les balises (?) <B> de chaque côté de mon groupe de mots mais lesdites balises apparaissent dans le mail et rien n'est en gras... Ça fait pas très beau comme résultat ! ;)
Voici mon code :
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
| Sub SendEMailHypo()
Dim Email As String, Subj As String
Dim Msg As String, URL As String
Email = Cells(ActiveCell.Row, 25)
Subj = "Votre Lorem ipsum"
Msg = ""
Msg = Msg & "Bonjour " & Cells(ActiveCell.Row, 4) & "," & vbCrLf & vbCrLf _
& "Déjà 5 ans et voilà que Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat. " _
& vbCrLf & vbCrLf _
& "Vous désirez obtenir Lorem ipsum dolor sit amet, consectetuer adipiscing elit, sed diam nonummy nibh euismod tincidunt ut laoreet dolore magna aliquam erat volutpat. Ut wisi enim ad minim veniam, quis nostrud exerci tation ullamcorper suscipit lobortis nisl ut aliquip ex ea commodo consequat." _
& vbCrLf & vbCrLf _
& "Dans l'attente blablablabla" _
& vbCrLf & vbCrLf _
'Replace spaces with %20 (hex)
Subj = Application.WorksheetFunction.Substitute(Subj, " ", "%20")
Msg = Application.WorksheetFunction.Substitute(Msg, " ", "%20")
'Replace carriage returns with %0D%0A (hex)
Msg = Application.WorksheetFunction.Substitute(Msg, vbCrLf, "%0D%0A")
'Create the URL
URL = "mailto:" & Email & "?subject=" & Subj & "&body=" & Msg
'Execute the URL (start the email client)
ShellExecute 0&, vbNullString, URL, vbNullString, vbNullString, vbNormalFocus
'Wait two seconds before sending keystrokes
'Application.Wait (Now + TimeValue("0:00:02"))
'Application.SendKeys "%s"
End Sub |
Je voudrais mettre en gras, par exemple, "sed diam nonummy nibh euismod tincidunt" dans le premier paragraphe, et "Ut wisi enim ad minim veniam" dans le deuxième.
Que dois-je faire ? Est-ce qu'il faut couper les phrases là où on veut formater en gras et les reprendre ensuite avec des & et je ne sais quel autre signe magique ou mystérieuse "balise" ?
J'ai vu aussi qu'il y a une question de format HTML... Mais encore là je nage : dans mon code, je ne vois rien qui indique ce format ou un autre ?
Merci à l'avance de votre aide.
Autre code... Autre problème...
Re-bonjour à tous,
J'ai fini par trouver un autre code qui me permet d'utiliser les balises pour mettre mon texte en gras. Yé !
Cependant, au lieu d'utiliser le Times New Roman 11 qui est la police par défaut de mes messages Outlook, il utilise Calibri 10... ??? Je ne vois pourtant nulle part dans ce code une déclaration de Font... ?
Code:
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
| Sub EnvoiMail()
' Working in Office 2000-2013
Dim OutApp As Object
Dim OutMail As Object
Dim strbody As String
Set OutApp = CreateObject("Outlook.Application")
Set OutMail = OutApp.CreateItem(0)
strbody = "Bonjour," & _
"<br><br>Blalalala ldjf slfjslfj slfjs;alfjs;aldsa;ldasldfjas;d.<br>" & _
"<br>Blablalbalblablalala <b>en gras en gras en gras</b> blablalbalblalalalalala." & _
"<br><br>blablablablablabla" & _
"<br><br><b>PS. Blalalalalalalalalalalala</b>."
On Error Resume Next
With OutMail
.Display
.To = Cells(ActiveCell.Row, 25)
'.CC = ""
'.BCC = ""
.Subject = "Test mail"
.HTMLBody = strbody & "<br>" & .HTMLBody
.Display
End With
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub |
Auriez-vous une solution ? Merci à l'avance !
