Afficheur_combninatoire

=INDEX($B$10:$B$16;D10)

Function Fact(Nombre) As Double
Dim Boucle As Integer
Fact = 1
For Boucle = 2 To Int(Nombre)
Fact = Fact * Boucle
Next Boucle
End Function
Function Combin(NbElts As Integer, NbEltsChoisis As Integer)
  Combin = Fact(NbElts) / (Fact(NbEltsChoisis) * Fact(NbElts - NbEltsChoisis))
End Function

Sub Comb()
Dim b%, s%, Nc&, i%, Tb(), j%, oS1 As Worksheet
Set oS1 = Worksheets("Cmb")
If WorksheetFunction.IsNumber(oS1.Cells(2, 1)) Then
    b = oS1.Cells(2, 1)
Else
    MsgBox "Nombre d'objets n'est pas un nombre"
    Exit Sub
End If
If WorksheetFunction.IsNumber(oS1.Cells(4, 1)) Then
    s = oS1.Cells(4, 1)
Else
    MsgBox "Nombre d'emplacements n'est pas un nombre"
    Exit Sub
End If
If b < s Then
    MsgBox "Nombre d'objets < Nombre d'emplacements"
    Exit Sub
End If
If oS1.Cells(Rows.Count, 1).End(xlUp).Row - 7 < b Then
    MsgBox "Nombre d'objets > Liste d'Objets"
    Exit Sub
End If
Application.ScreenUpdating = False
oS1.Range(oS1.Cells(2, 2), oS1.Cells(Rows.Count, Columns.Count)).ClearContents
oS1.Range(oS1.Cells(2, 2), oS1.Cells(Rows.Count, Columns.Count)).Interior.Pattern = xlNone
oS1.Range(oS1.Cells(1, 4), oS1.Cells(1, Columns.Count)).ClearContents
oS1.Range(oS1.Cells(1, 4), oS1.Cells(1, Columns.Count)).Interior.Pattern = xlNone
ReDim Tb(1 To b)
For i = 1 To b
    Tb(i) = oS1.Cells(7 + i, 1)
Next i
Nc = Combin(b, s)
For i = 1 To s
    oS1.Cells(2, 2 + i) = i
Next i
If Nc > 1 Then
    For i = 1 To s
        Select Case i
            Case s
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C=" & b & ",RC[-1]+1,R[-1]C+1)"
            Case 1
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (b - s + 2) & _
                    ",R[-1]C+1,R[-1]C)"
            Case Else
                oS1.Cells(3, 2 + i).FormulaR1C1 = "=IF(R[-1]C[1]=" & (b - s + 1 + i) _
                    & ",IF(R[-1]C=" & (b - s + i) & ",RC[-1]+1,R[-1]C+1),R[-1]C)"
        End Select
    Next i
    oS1.Range(oS1.Cells(3, 3), oS1.Cells(3, 2 + s)).Copy Destination:=oS1.Range(oS1.Cells(3, 3), oS1.Cells(Nc + 1, 2 + s))
    Application.CutCopyMode = False
    oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).Copy
    oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).PasteSpecial Paste:=xlPasteValues
    Application.CutCopyMode = False
End If
For i = 1 To Nc
    For j = 1 To s
        oS1.Cells(i + 1, j + 2) = Tb(oS1.Cells(i + 1, j + 2))
    Next j
Next i
oS1.Cells(1, 3).Copy
oS1.Range(oS1.Cells(2, 3), oS1.Cells(Nc + 1, 2 + s)).PasteSpecial Paste:=xlPasteFormats
Application.CutCopyMode = False
For i = 1 To Nc
    oS1.Cells(i + 1, 2) = i
Next i
If b > 1 Then oS1.Cells(1, 3).AutoFill Destination:=oS1.Range(oS1.Cells(1, 3), oS1.Cells(1, 2 + s)), Type:=xlFillDefault
Application.ScreenUpdating = True
End Sub

If b > 1 Then oS1.Cells(1, 3).AutoFill Destinatio