- '##########################################################################################
- '# Fonction retournant le code HTML du texte du contrôle rich text box passé en paramètre #
- '##########################################################################################
- ' Paramètre(s) : vvRTBCtl -> contrôle RichTextBox contenant le texte à convertir
- ' Résultat(s) : convertRTFtoHTML -> Code HTML correspondant
- Public Function convertRTFtoHTML(vvRTBCtl As Control) As String
- Dim a
- Dim IsBold As Boolean
- Dim IsUnderline As Boolean
- Dim IsItalic As Boolean
- Dim vlStr As String
-
- On Error Resume Next
-
- IsItalic = False
- IsUnderline = False
- IsBold = False
-
- vlStr = ""
-
- For a = 0 To Len(vvRTBCtl.Text) + 2
- vvRTBCtl.SelStart = a + 1
- If vvRTBCtl.SelStart = Len(vvRTBCtl.Text) + 1 Then
- IsBold = False
- IsUnderline = False
- IsItalic = False
- End If
-
- 'Mettre en Gras
- If vvRTBCtl.SelBold = True And IsBold = False Then
- IsBold = True
- vlStr = vlStr & "<B>"
- End If
- If vvRTBCtl.SelBold = False And IsBold = True Then
- IsBold = False
- vlStr = vlStr & "</B>"
- End If
-
- 'Mettre en souligner
- If vvRTBCtl.SelUnderline = True And IsUnderline = False Then
- IsUnderline = True
- vlStr = vlStr & "<U>"
- End If
- If vvRTBCtl.SelUnderline = False And IsUnderline = True Then
- IsUnderline = False
- vlStr = vlStr & "</U>"
- End If
-
- 'Mettre en italic
- If vvRTBCtl.SelItalic = True And IsItalic = False Then
- IsItalic = True
- vlStr = vlStr & "<I>"
- End If
- If vvRTBCtl.SelItalic = False And IsItalic = True Then
- IsItalic = False
- vlStr = vlStr & "</I>"
- End If
-
- If Asc(Mid(vvRTBCtl.Text, a + 1, 1)) = vbKeyReturn Then
- vlStr = vlStr & "<br>"
- Else
- vlStr = vlStr & Mid(vvRTBCtl.Text, a + 1, 1)
- End If
-
- If a = Len(vvRTBCtl.Text) - 1 Then
- vlStr = vlStr & "</I>"
- vlStr = vlStr & "</U>"
- vlStr = vlStr & "</B>"
- End If
- Next
- convertRTFtoHTML = vlStr
- End Function
-
'##########################################################################################
'# Fonction retournant le code HTML du texte du contrôle rich text box passé en paramètre #
'##########################################################################################
' Paramètre(s) : vvRTBCtl -> contrôle RichTextBox contenant le texte à convertir
' Résultat(s) : convertRTFtoHTML -> Code HTML correspondant
Public Function convertRTFtoHTML(vvRTBCtl As Control) As String
Dim a
Dim IsBold As Boolean
Dim IsUnderline As Boolean
Dim IsItalic As Boolean
Dim vlStr As String
On Error Resume Next
IsItalic = False
IsUnderline = False
IsBold = False
vlStr = ""
For a = 0 To Len(vvRTBCtl.Text) + 2
vvRTBCtl.SelStart = a + 1
If vvRTBCtl.SelStart = Len(vvRTBCtl.Text) + 1 Then
IsBold = False
IsUnderline = False
IsItalic = False
End If
'Mettre en Gras
If vvRTBCtl.SelBold = True And IsBold = False Then
IsBold = True
vlStr = vlStr & "<B>"
End If
If vvRTBCtl.SelBold = False And IsBold = True Then
IsBold = False
vlStr = vlStr & "</B>"
End If
'Mettre en souligner
If vvRTBCtl.SelUnderline = True And IsUnderline = False Then
IsUnderline = True
vlStr = vlStr & "<U>"
End If
If vvRTBCtl.SelUnderline = False And IsUnderline = True Then
IsUnderline = False
vlStr = vlStr & "</U>"
End If
'Mettre en italic
If vvRTBCtl.SelItalic = True And IsItalic = False Then
IsItalic = True
vlStr = vlStr & "<I>"
End If
If vvRTBCtl.SelItalic = False And IsItalic = True Then
IsItalic = False
vlStr = vlStr & "</I>"
End If
If Asc(Mid(vvRTBCtl.Text, a + 1, 1)) = vbKeyReturn Then
vlStr = vlStr & "<br>"
Else
vlStr = vlStr & Mid(vvRTBCtl.Text, a + 1, 1)
End If
If a = Len(vvRTBCtl.Text) - 1 Then
vlStr = vlStr & "</I>"
vlStr = vlStr & "</U>"
vlStr = vlStr & "</B>"
End If
Next
convertRTFtoHTML = vlStr
End Function