XL 2019 Comment réaliser une saisie intuitive type (ab ab = Abies alba) et qui garde la mise en forme couleur de la BD sous userform

Private Sub ComboBox1_Change()

  If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, a, 0)) Then

    Set d1 = CreateObject("Scripting.Dictionary")

    tmp = UCase(Me.ComboBox1) & "*"

    For Each c In a

      If UCase(c) Like tmp Then d1(c) = ""

    Next c

    Me.ComboBox1.List = d1.keys

    Me.ComboBox1.DropDown

  End If

  ActiveCell.Value = Me.ComboBox1

    Dim Ind As Long, n As Long, Tt()

  ' Si le flag est actif on sort

  If FlgExit Then Exit Sub

  ' Vérifier si aucune valeur saisie

  If Me.ComboBox1 <> "" Then

     tmp = Split(Trim(Me.ComboBox1), " ")     ' divise puis réduit la combobox

     Tbl = a

     For i = LBound(tmp) To UBound(tmp)

       Tbl = Filter(Tbl, tmp(i), True, vbTextCompare)

     Next i

     Me.ComboBox1.List = Tbl

     Me.ComboBox1.DropDown

 End If


End Sub

Private Sub Label1_Click()

End Sub

Private Sub Label3_Click()

End Sub

Private Sub Label4_Click()

End Sub

Private Sub UserForm_Initialize()
Dim f
Set f = Sheets("BD")
ComboBox1.Clear
i = 0
Set design = f.Range("A2:A" & f.[a65000].End(xlUp).Row)
For Each c In design
    If c <> "" Then tmp = c
    Me.ComboBox1.AddItem tmp
    Me.ComboBox1.List(i, 1) = c.Offset(, 1)
    Me.ComboBox1.List(i, 2) = c.Offset(, 2)
    Me.ComboBox1.List(i, 3) = c.Offset(, 3)
    Me.ComboBox1.List(i, 4) = c.Row
    i = i + 1
Next
End Sub
Private Sub ComboBox1_click()
  Me.TextBox1 = Me.ComboBox1.Column(1)
  Me.TextBox2 = Me.ComboBox1.Column(2)
  Me.TextBox3 = Me.ComboBox1.Column(3)
End Sub

Private Sub B_ok_Click()

  ActiveCell.Offset(, 0) = Me.TextBox3
  ActiveCell.Offset(, -1) = Me.TextBox2
  ActiveCell.Font.Name = "Arial"
  ActiveCell.Font.Size = 11 'Affiche toute la plage de cellule en taille de police 11
  ActiveCell.Font.Bold = False

ActiveCell.Interior.Color = RGB(226, 239, 218)
   Dim balise1$, balise2$, L1$, L2$, a$(), c As Range, n&, x$, sup%, i%, j%, k%, ss, s
balise1 = "<i>": balise2 = "</i>": L1 = Len(balise1): L2 = Len(balise2)
Application.ScreenUpdating = False
ActiveCell.Font.Italic = False 'RAZ
With ActiveSheet.UsedRange 'la feuille active est traitée
    '---tableau des bornes---
    ReDim a(1 To .Count)
    For Each c In .Cells
        n = n + 1
        x = CStr(c)
        sup = 0
        For i = 1 To Len(x)
            If Mid(x, i, L1) = balise1 Then
                j = InStr(i + L1, x, balise2)
                k = InStr(i + L1, x, balise1)
                If k = 0 Then k = 32767
                If j And j <= k Then
                    sup = sup + L1
                    a(n) = a(n) & " " & i - sup + L1 & "," & j - i - L1
                    sup = sup + L2
                    i = j + L2 - 1
                End If
            End If
    Next i, c
    '---effacement des 2 balises---
    .Replace balise1, "", xlPart
    .Replace balise2, ""
    '---application des formats---
    n = 0
    For Each c In .Cells
        n = n + 1
        If a(n) <> "" Then
            ss = Split(a(n))
            For i = 1 To UBound(ss)
                s = Split(ss(i), ",")
                c.Characters(s(0), s(1)).Font.Italic = True
            Next i
        End If
    Next c
End With
If Me.ComboBox1 <> "" Then 'Si la zone de saisie de la combobox comporte un de ces mots alors il sera sans italic
mot = "subsp."
  For Each c In Range("B22:B180")
   P = InStr(UCase(c), UCase(mot))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot)).Font.Italic = False 'Valeur italique fausse, donc Subsp ecrit sans italic
  Next c
  mot2 = "var."
  For Each c In Range("B22:B180")
   P = InStr(UCase(c), UCase(mot2))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot2)).Font.Italic = False
  Next c
  mot3 = "sp."
  For Each c In Range("B22:B180")
   P = InStr(UCase(c), UCase(mot3))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
  Next c
  mot3 = "x"
  For Each c In Range("B22:B180")
   P = InStr(UCase(c), UCase(mot3))
   If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
  Next c
  End If
   



  Unload Me
End Sub