Dim choix1()
Private Sub Label4_Click()
End Sub
Private Sub Label1_Click()
End Sub
Private Sub TextBox2_Change()
End Sub
Private Sub UserForm_Initialize()
Me.ComboBox1.Clear
choix1 = Application.Transpose([Liste])
Dim choix2
Dim i!
For i = 1 To UBound(choix1)
If InStr(1, choix2, choix1(i)) = 0 Then choix2 = choix2 & "|" & choix1(i)
Next i
choix2 = Split(Right(choix2, Len(choix2) - 1), "|")
choix1 = Application.Transpose(Application.Transpose(choix2))
ComboBox1.SetFocus
test1 = Application.Transpose([lb_nom_URL])
Me.ComboBox1.List = choix1
End Sub
Private Sub ComboBox1_Change()
Dim Ind As Long, n As Long, Tt()
If Me.ComboBox1.ListIndex = -1 And IsError(Application.Match(Me.ComboBox1, choix1, 0)) Then
Me.ComboBox1.List = Filter(choix1, Me.ComboBox1.Text, True, vbTextCompare)
If Me.ComboBox1 <> "" Then
mots = Split(Trim(Me.ComboBox1), " ") ' divise puis réduit la combobox
Tbl = choix1
For i = LBound(mots) To UBound(mots)
Tbl = Filter(Tbl, mots(i), True, vbTextCompare)
Next i
Me.ComboBox1.List = Tbl
Me.ComboBox1.DropDown
End If
Me.TextBox1 = ""
Me.TextBox2 = ""
Me.TextBox3 = ""
Else
P = Application.Match(Me.ComboBox1, choix1, 0)
Me.TextBox1 = Range("info")(P)
P = Application.Match(Me.ComboBox1, choix1, 0)
Me.TextBox3 = Range("ZH")(P)
P = Application.Match(Me.ComboBox1, choix1, 0)
Me.TextBox2 = Range("lb_nom_URL")(P)
End If
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 13 Then CommandButton1_Click
If KeyCode = 38 Or KeyCode = 40 Then FlgExit = True
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
ComboBox1.ListIndex = -1
Me.ComboBox1.List = choix1
End Sub
Private Sub CommandButton1_Click()
tmp = Me.ComboBox1
If IsNumeric(tmp) Then tmp = CDbl(tmp)
ActiveCell.Offset(, 1) = tmp
ActiveCell.Offset(, 2) = Me.TextBox1
ActiveCell = Me.TextBox2
ActiveCell.Font.Name = "Arial"
ActiveCell.Font.Size = 10
ActiveCell.Font.Bold = False
ActiveCell.Font.Italic = False
ActiveCell.Font.Underline = False
Unload Me
Application.OnKey "{ENTER}", "valider"
[COLOR=rgb(226, 80, 65)] 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
Cells.Font.Italic = False 'RAZ
With ActiveCell '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[/COLOR]
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 ActiveCell
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 ActiveCell
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 ActiveCell
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 ActiveCell
P = InStr(UCase(c), UCase(mot3))
If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
Next c
mot3 = "+ "
For Each c In ActiveCell
P = InStr(UCase(c), UCase(mot3))
If P > 0 Then c.Characters(Start:=P, Length:=Len(mot3)).Font.Italic = False
Next c
End If
End Sub