'### Constantes à adapter à votre usage ###
Const PRODUITS As String = "Produits"
Const PARCELLES As String = "Parcelles"
Public Const COLONNE_LISTBOX As Long = 3
'##########################################
Dim var
Sub AddListe(R As Range)
Dim numCol&
Dim lastLig&
Dim i&
Dim Sh As Worksheet
Dim Sh2 As Worksheet
Dim R2 As Range
Dim S As Shape
Set Sh = R.Parent
numCol& = R.Column
If numCol& < 5 Then
Set Sh2 = ThisWorkbook.Sheets(PARCELLES)
lastLig& = Sh2.[a65536].End(xlUp).Row
var = Sh2.Range("a2:d" & lastLig& & "")
Set R2 = Sh2.Range(Sh2.Cells(2, numCol&), Sh2.Cells(lastLig&, numCol&))
ElseIf numCol& > 5 Then
Set Sh2 = ThisWorkbook.Sheets(PRODUITS)
lastLig& = Sh2.[a65536].End(xlUp).Row
Set R2 = Sh2.Range("a2:h" & lastLig& & "")
var = R2
If numCol& = 6 Then i& = 8
If numCol& = 7 Then i& = 2
If numCol& = 8 Then i& = 5
If numCol& = 9 Then i& = 7
Set R2 = Sh2.Range(Sh2.Cells(2, i&), Sh2.Cells(lastLig&, i&))
End If
Set S = Sh.Shapes.AddFormControl(xlDropDown, _
R.Left, R.Top, R.Width, R.Height)
S.ControlFormat.ListFillRange = Sh2.Name & "!" & R2.Address
S.OnAction = "DropDownSurClic"
S.Select
Selection.DropDownLines = 12
R.Select
End Sub
Sub DropDownSurClic()
Dim S As Shape
Dim DD As DropDown
Dim R As Range
Dim lig&
Dim T()
Dim i&
For Each S In ActiveSheet.Shapes
If S.FormControlType = xlDropDown Then
Set DD = S.OLEFormat.Object
Exit For
End If
Next S
lig& = Selection.Row
Set R = ActiveSheet.Range(Cells(lig&, 1), Cells(lig&, 4))
ReDim T(1 To 1, 1 To 4)
If Left(DD.ListFillRange, Len(PARCELLES)) = PARCELLES Then
For i& = 1 To 4
T(1, i&) = var(DD.ListIndex, i&)
Next i&
Else
T(1, 1) = var(DD.ListIndex, 8)
T(1, 2) = var(DD.ListIndex, 2)
T(1, 3) = var(DD.ListIndex, 5)
T(1, 4) = var(DD.ListIndex, 7)
Set R = R.Offset(0, 5)
End If
R = T
Call DelListe
Application.EnableEvents = False
Selection.Offset(1, 0).Select
Application.EnableEvents = True
End Sub
Sub DelListe(Optional dummy As Byte)
Dim S As Shape
For Each S In ActiveSheet.Shapes
If S.FormControlType = xlDropDown Then
S.Cut
End If
Next S
End Sub
