' Code permettant le choix dans les combobox avec une recherche intuitive sur le début du mot
If Not Intersect([Choix_Fonctions], target) Is Nothing And target.Count = 1 Then
Fonctions = Application.Transpose(Sheets("BD").Range("Fonctions").Value)
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In Fonctions
If c <> "" Then d1(c) = ""
Next c
TblFonctions = d1.keys
Me.ComboBox1.List = TblFonctions
Me.ComboBox1.Height = target.Height + 3
Me.ComboBox1.Width = target.Width
Me.ComboBox1.Top = target.Top
Me.ComboBox1.Left = target.Left
Me.ComboBox1 = target
Me.ComboBox1.Visible = True
Me.ComboBox1.Activate
'If Target <> "" Then SendKeys "{esc}"
Else
Me.ComboBox1.Visible = False
End If
'----
If Not Intersect([Choix_Chantiers], target) Is Nothing And target.Count = 1 Then
Condition = UCase(target.Offset(, -1))
If Condition = "" Then Exit Sub
Chantiers = Application.Transpose(Sheets("BD").Range("Chantiers").Value)
Fonctions = Application.Transpose(Sheets("BD").Range("Fonctions").Value)
ReDim TblChantiers(1 To UBound(Fonctions))
Set d1 = CreateObject("Scripting.Dictionary")
For i = LBound(Chantiers) To UBound(Chantiers)
If Fonctions(i) = Condition Then d1(Chantiers(i)) = ""
Next i
TblChantiers = d1.keys
Me.ComboBox2.List = TblChantiers
Me.ComboBox2.Height = target.Height + 3
Me.ComboBox2.Width = target.Width
Me.ComboBox2.Top = target.Top
Me.ComboBox2.Left = target.Left
Me.ComboBox2 = target
Me.ComboBox2.Visible = True
Me.ComboBox2.Activate
'If Target <> "" Then SendKeys "{esc}"
'Me.ComboBox2.DropDown ' ouverture automatique au clic dans la cellule (optionel)
Else
Me.ComboBox2.Visible = False
End If
'---
If Not Intersect([Choix_Positions], target) Is Nothing And target.Count = 1 Then
Condition1 = UCase(target.Offset(, -2))
Condition2 = UCase(target.Offset(, -1))
If Condition1 = "" Or Condition2 = "" Then Exit Sub
Chantiers = Application.Transpose(Sheets("BD").Range("Chantiers").Value)
Fonctions = Application.Transpose(Sheets("BD").Range("Fonctions").Value)
Positions = Application.Transpose(Sheets("BD").Range("Positions").Value)
ligne = 0
ReDim TblPositions(1 To UBound(Fonctions))
For i = LBound(Chantiers) To UBound(Chantiers)
If Fonctions(i) = Condition1 And Chantiers(i) = Condition2 Then
ligne = ligne + 1: TblPositions(ligne) = Positions(i)
End If
Next i
If TblPositions(1) <> "" Then
ReDim Preserve TblPositions(1 To ligne)
Me.ComboBox3.List = TblPositions
Me.ComboBox3.Height = target.Height + 3
Me.ComboBox3.Width = target.Width
Me.ComboBox3.Top = target.Top
Me.ComboBox3.Left = target.Left
Me.ComboBox3 = target
Me.ComboBox3.Visible = True
Me.ComboBox3.Activate
'If Target <> "" Then SendKeys "{esc}"
'Me.ComboBox1.DropDown ' ouverture automatique au clic dans la cellule (optionel)
Else
target = "Néant"
End If
Else
Me.ComboBox3.Visible = False
End If
End Sub
Private Sub ComboBox1_Change()
If Me.ComboBox1 <> "" And IsError(Application.Match(Me.ComboBox1, TblFonctions, 0)) Then
Set d1 = CreateObject("Scripting.Dictionary")
For Each c In TblFonctions
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox1.List = Filter(TblFonctions, Me.ComboBox1.Text, True, vbTextCompare)
Me.ComboBox1.DropDown
End If
ActiveCell.Value = Me.ComboBox1 ': ActiveCell.Offset(, 1) = "": ActiveCell.Offset(, 2) = ""
End Sub
Private Sub ComboBox2_Change()
If Me.ComboBox2 <> "" And IsError(Application.Match(Me.ComboBox2, TblChantiers, 0)) Then
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox2) & "*"
For Each c In TblChantiers
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox2.List = Filter(TblChantiers, Me.ComboBox2.Text, True, vbTextCompare)
Me.ComboBox2.DropDown
End If
ActiveCell.Value = Me.ComboBox2 ': ActiveCell.Offset(, 1) = ""
End Sub
Private Sub ComboBox3_Change()
If Me.ComboBox3 <> "" And IsError(Application.Match(Me.ComboBox3, TblPositions, 0)) Then
Set d1 = CreateObject("Scripting.Dictionary")
tmp = UCase(Me.ComboBox3) & "*"
For Each c In TblPositions
If UCase(c) Like tmp Then d1(c) = ""
Next c
Me.ComboBox3.List = Filter(TblPositions, Me.ComboBox3.Text, True, vbTextCompare)
Me.ComboBox3.DropDown
End If
ActiveCell.Value = Me.ComboBox3
End Sub
Private Sub ComboBox2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox2.List = TblChantiers
Me.ComboBox2.Activate
Me.ComboBox2.DropDown
End Sub
Private Sub ComboBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox1.List = TblFonctions
Me.ComboBox1.Activate
Me.ComboBox1.DropDown
End Sub
Private Sub ComboBox3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Me.ComboBox3.List = TblPositions
Me.ComboBox3.Activate
Me.ComboBox3.DropDown
End Sub
Private Sub ComboBox3_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 9 Then
If Shift = 1 Then
ActiveCell.Offset(, -1).Select
Else
ActiveCell.Offset(, 1).Select
End If
End If
End Sub
Private Sub ComboBox2_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 9 Then
If Shift = 1 Then
ActiveCell.Offset(, -1).Select
Else
ActiveCell.Offset(, 1).Select
End If
End If
End Sub
Private Sub ComboBox1_KeyDown(ByVal KeyCode As MSForms.ReturnInteger, ByVal Shift As Integer)
If KeyCode = 9 Then
If Shift = 1 Then
ActiveCell.Offset(, -1).Select
Else
ActiveCell.Offset(, 1).Select
End If
End If
End Sub