Bonjour,

Bon mon petit problème est simple :

- J'aimerais pouvoir transformer la mise en forme Excel en mise en forme HTML et vice versa.

Petite précision, quand je parle de mise en forme, il ne s'agit que de la couleur de la police, Souligner, Gras et italique.

J'ai déjà créer une fonction mais Le gros probléme est qu'elle bouffe enormement de ressource.

En gros, le principe c'est qu'elle passe sur chaque caractère pour insérer ou la balise s'il y a changement :

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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 + "&lt;"
            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
Quelqu'un aurait il une façon pour améliorer mon code ?
Ou
Quelqu'un connait il une fonction permettant de faire ce que je fais ?

P.S. : J'ai penser a essayer d'appeler une fonction word mais je en sais pas si une fonction est prévue a cette effet