Sub test()
Dim j, i, NbrCouleur As Integer
Dim nbrCoulec()
NbrCouleur = InputBox("Nombre de couleur")
Range("A1").Select
'---------------------------------------------
'détermination de la taille du tableau encadré
'colonne
While Selection.Offset(0, jmax).Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Offset(0, jmax).Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Offset(0, jmax).Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Offset(0, jmax).Borders(xlEdgeLeft).LineStyle = xlContinuous
jmax = jmax + 1
Wend
'ligne
While Selection.Offset(imax, 0).Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Offset(imax, 0).Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Offset(imax, 0).Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Offset(imax, 0).Borders(xlEdgeLeft).LineStyle = xlContinuous
imax = imax + 1
Wend
'determination du nombre de cellule fusionnée
For i = 0 To imax
For j = 0 To jmax
If Selection.Offset(i, j).MergeCells = True Then
nbrCellFus = nbrCellFus + 1
End If
Next
j = 0
Next
nbrCellule = imax * jmax - nbrCellFus
'---------------------------------------------
'détermination du nombre de fois des couleur
ReDim nbrCoulec(NbrCouleur)
coulrest = nbrCellule
For i = 1 To NbrCouleur
nbrCoulec(i) = InputBox("Nombre de fois la couleur d'interior " & i & "/" & NbrCouleur & " .Il reste " & coulrest & " couleur a saisir")
coulrest = coulrest - Val(nbrCoulec(i))
If Val(nbrCoulec(i)) > nbrCellule Or coulrest < 0 Then
MsgBox "nombre trop important, recommencer !", vbCritical
End
End If
Next
If coulrest > 0 Then
MsgBox "Il manque des couleurs !", vbCritical
End
End If
'---------------------------------------------
'remplissage
For i = 0 To imax
If Selection.Offset(i, j).Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeLeft).LineStyle = xlContinuous Then
For j = 0 To jmax
If Selection.Offset(i, j).Borders(xlEdgeBottom).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeTop).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeRight).LineStyle = xlContinuous And Selection.Offset(i, j).Borders(xlEdgeLeft).LineStyle = xlContinuous Then
retest: Val_couleur = Int((Val(NbrCouleur) * Rnd) + 1)
If nbrCoulec(Val_couleur) > 0 Then
nbrCoulec(Val_couleur) = nbrCoulec(Val_couleur) - 1
Selection.Offset(i, j).Interior.ColorIndex = Val_couleur
Else
GoTo retest
End If
End If
Next
j = 0
End If
Next
End Sub