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 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119
|
Private Sub CreationBalise()
Dim cell As Range
Dim ColorDefault As Integer
Dim t As String
Dim d As Integer ' counter
Dim s As String ' tanpom
Dim b As Boolean ' for BOLD
Dim U As Boolean ' for underline
Dim i As Boolean ' for Italic
Dim C As Long ' for Color
Dim test
For Each cell In Selection
ColorDefault = 0
C = ColorDefault
t = cell.Value
s = "<html><body>"
If Replace(cell.Value, "<html><body>", "") <> cell.Value Then Exit Sub
For d = 1 To Len(cell.Value) Step 1
If cell.Characters(d, 1).Font.Bold = True Then ' Gestion Du gras
If b = False Then '
s = s + "<b>" '
b = True '
End If '
End If '
If cell.Characters(d, 1).Font.Bold = False And b = True Then '
s = s + "</b>" '
b = False '
End If '
If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleSingle Then ' Gestion du soulignement
If U = False Then '
s = s + "<u>" '
U = True '
End If '
End If '
If cell.Characters(d, 1).Font.Underline = xlUnderlineStyleNone And U = True Then '
s = s + "</u>" '
U = False '
End If '
If cell.Characters(d, 1).Font.Italic = True Then ' Gestion de l'italique
If i = False Then '
s = s + "<i>" '
i = True '
End If '
End If '
If cell.Characters(d, 1).Font.Italic = False And i = True Then '
s = s + "</i>" '
i = False '
End If '
EntierDetect:
If cell.Characters(d, 1).Font.Color <> ColorDefault Then ' Gestion de la couleur
Dim Rouge, vert, Bleu As Integer
Rouge = Int(cell.Characters(d, 1).Font.Color Mod 256)
vert = Int((cell.Characters(d, 1).Font.Color Mod 65536) / 256)
Bleu = Int(cell.Characters(d, 1).Font.Color / 65536)
If cell.Characters(d, 1).Font.Color <> C And C <> ColorDefault Then
s = s + "</font>"
'If Rouge <> 0 And Vert <> 0 And Bleu <> 0 Then
s = s + "<font color=""#" _
+ Format(Hex(Rouge), "##00") _
+ Format(Hex(vert), "##00") _
+ Format(Hex(Bleu), "##00") _
+ """>"
'End If
C = cell.Characters(d, 1).Font.Color '
ElseIf C = ColorDefault And cell.Characters(d, 1).Font.Color <> ColorDefault Then
'If Rouge <> 0 And Vert <> 0 And Bleu <> 0 Then
s = s + "<font color=""#" _
+ Format(Hex(Rouge), "##00") _
+ Format(Hex(vert), "##00") _
+ Format(Hex(Bleu), "##00") _
+ """>"
'End If
C = cell.Characters(d, 1).Font.Color '
End If
End If
If cell.Characters(d, 1).Font.Color = ColorDefault And C <> ColorDefault Then
s = s + "</font>"
C = ColorDefault
End If '
If (CutString(t, d - 1, 1) = "<") Then
s = s + "<"
ElseIf (CutString(t, d - 1, 1) = ">") Then
s = s + "&rt;"
Else
s = s + Right(Left(cell.Value, d), 1)
End If
Next
If b = True Then
s = s + "</b>"
b = False
End If
If U = True Then
s = s + "</u>"
U = False
End If
If i = True Then
s = s + "</i>"
i = False
End If
If C <> ColorDefault Then '
s = s + "</font>" '
C = ColorDefault '
End If
s = Replace(s, Chr(10), "<br>") ' Gestion saut de ligne
cell.Value = s + "</body></html>"
Next
End Sub |
Partager