Macro pour répartition automatique et coloriage de cellules

[Capitaine Flame]

Bonjour à tous.

Pour commencer, un grand merci pour l'aide que vous pouvez m'apporter. Mes connaissance Excel étant plutôt limités, je me dois de vous remercier, car les questions que je vous ai posté ont toutes été résolue.

Alors un grand merci!

J'ai une fois de plus besoin de faire appel à vos connaissances Excel.

Je dois colorier un ensemble de cellules sur une feuille.

La disposition et le nombre de cellules peut varier suivant mon besoin.
Je dois pouvoir choisir le nombre de couleur (de 2 à 15), le choix de la couleur, la quantité de répartition par couleur.
Une fois les paramètres rentrées, la répartition doit se faire de façon aléatoire (pas 2 fois la même chose).

J'espère avoir été assez clair dans mon exmplication. Je joins un fichier avec 2 exemple pour complèter l'explication ci-dessus.

Merci pour votre aide si préciseuse.

 

[GI_tang]

Re : Macro pour répartition automatique et coloriage de cellules

Salut, ci-dessous une ébauche

la condition est que les cellule que tu veux colorié doivent être encadré.
toutes les autres ne seront pas colorié.

les puriste d'excel on certainement mieu mais ca marche.

a toi de l'adapté pour les tailles de boucle etc ... la c'est du vite fait

Sub test()

Dim j, i, NbrCouleur As Integer


NbrCouleur = 6

Range("A1").Select

    For i = 0 To 6000
        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 250
                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
                       Selection.Offset(i, j).FormulaR1C1 = "=RAND()*" & NbrCouleur
                       Selection.Offset(i, j).NumberFormat = "0"
                       Selection.Offset(i, j).Interior.ColorIndex = Selection.Offset(i, j).Value
                       Selection.Offset(i, j).ClearContents
                End If
            Next
            j = 0
        End If
    Next

End Sub

 

[sousou]

Re : Macro pour répartition automatique et coloriage de cellules

Bonjour le fil

Ici les cellules fusionnées ne sont pas prise en compte,
Je traite le nombre de couloeurs,le probléme de répartition des couleurs( Pas compris!)

Sub remplissage()
rep = InputBox("Nombre de couleur")
For Each i In Selection
If i.MergeCells = False Then
c = Int((Val(rep) * Rnd) + 1)
i.Interior.ColorIndex = c
End If
Next
End Sub

 

[Capitaine Flame]

Re : Macro pour répartition automatique et coloriage de cellules

Merci GI tang.

Je constate que cela fonctionne pas mal. C'est un excellent début.

Penses-tu qu'il est possible (maintenant) de paramétrer un choix des couleurs par une boite de dialogue ou autre solution simple, et de pouvoir choisir le nombre de fois que je souhaite avoir chaque couleur dans dans la zone à remplir?

Enfin, merci beaucoup pour ton aide.

 

[Capitaine Flame]

Re : Macro pour répartition automatique et coloriage de cellules

Merci Sousou.

Une autre méthode pour aborder le problème. tu apporte la solution pour choisir le nombre de couleur. Nickel la boite de dialogue.

Merci pour la partie de solution que tu apportes.

 

[GI_tang]

Re : Macro pour répartition automatique et coloriage de cellules

ta solution ne fonctionne pas si il y a dans sa forme a ne pas colorié une cellule de large et haut et ainsi non fusionner. En mélangeant nos 2 solution ca peut être bon.
Sinon Capitaine Flame, je comprend pas très bien, tu veux un paramètre pour définir le nombre de couleur consécutive au maximum? c'est ca?

 

[Capitaine Flame]

Re : Macro pour répartition automatique et coloriage de cellules

Effectivement les 2 solutions apportées sont différentes. L'une prend en compte les cases qui sont encadrée, l'autre demande de présélectionner les cases que l'on souhaite colorer. Je préfère donc la première solution.

Maintenant, la boite de dialogue avec le choix du nombre de couleur me plait beaucoup.

Pour répondre à ta question (GI tang), je souhaite pouvoir répartir la quantité de case par couleur. Pour exemple, je choisi de prendre 5 couleurs différentes pour remplir 300 cases encadrées. Je souhaite pourvoir imposer 50 cases de couleur rouge, 80 cases de couleur bleu, 30 cases de couleurs verte, 100 cases de couleurs jaune, et 40 cases de couleur violet. Si c'est possible avec une boite de dialogue, c'est encore mieux, mais je pense que j'en demande beaucoup.

Enfin merci.

 

[GI_tang]

Re : Macro pour répartition automatique et coloriage de cellules

voici j'espère que ca répond a tes attentes :

il reste juste a modifier l'input box pour afficher la couleur en texte et non en chiffre, mais je me suis pas pencher dessus, ca doit être vite faisable, ca n'est qu'une histoire de format

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

 

[Capitaine Flame]

Re : Macro pour répartition automatique et coloriage de cellules

GI tang, milles merci!

Ta réponse me premet d'avancer un bon coup.
Je vais chercher pour la box du choix des couleur. Je pense ajouter quelques lignes au dessus de la zone de cadrillage avec des cellules ou je sélectionnerai les couleurs choisies. Je vais mapuyer sur ces cellules pour la macro.

Enfin merci pour votre aide.

 

[GI_tang]

Re : Macro pour répartition automatique et coloriage de cellules

de rien

je suis au taf et j'ai rien a faire aujourd'hui alors j'aide ceux que je peux. Tu peux donc clôturer cette discussion si tu as tes réponses

a charge de revanche