Dim CB(0) As New Classe1 'mémorise le tableau
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set Target = Intersect(Target.EntireRow, Sh.Range("F2:G" & Sh.Rows.Count), Sh.UsedRange.EntireRow)
If Target Is Nothing Then Exit Sub
Dim d As Object, dd As Object, tablo, i&, col%
'---listes des paniers et des clients---
Set d = CreateObject("Scripting.Dictionary")
Set dd = CreateObject("Scripting.Dictionary")
d.CompareMode = vbTextCompare 'la casse est ignorée
dd.CompareMode = vbTextCompare 'la casse est ignorée
tablo = Sheets("Liste Clients").[A1].CurrentRegion.Resize(, 2) 'matrice, plus rapide
For i = 1 To UBound(tablo)
d(tablo(i, 1)) = tablo(i, 2)
dd(tablo(i, 2)) = tablo(i, 1)
Next i
'---recherches des paniers et des clients---
Application.EnableEvents = False 'désactive les évènements
For Each Target In Target.Areas 'si entrées multiples (copier-coller)
tablo = Target 'matrice, plus rapide
col = ActiveCell.Column
For i = 1 To UBound(tablo)
If col = 6 Then
If d.exists(tablo(i, 1)) Then tablo(i, 2) = d(tablo(i, 1))
Else
If dd.exists(tablo(i, 2)) Then tablo(i, 1) = dd(tablo(i, 2))
End If
Next i
Target = tablo 'restitution
Next Target
Application.EnableEvents = True 'réactive les évènements
End Sub
Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
If Not IsDate(Sh.Name) Then Exit Sub
Set CB(0).CB = Sh.OLEObjects("ComboBox1").Object 'initialise la classe
With CB(0).CB
.Visible = False
If Intersect(ActiveCell, Sh.Range("G2:G" & Sh.Rows.Count)) Is Nothing Then Exit Sub
.Left = ActiveCell.Left
.Top = ActiveCell.Top
.Width = ActiveCell.Width
.Height = 16
.Visible = True
.Activate
.Text = Chr(1)
.Text = "" 'crée la liste
End With
End Sub