Progamme VBA pour remplissage de cellule en couleur pour valeur famille de 1000 a 9000

Version imprimable

08/05/2014, 23h51
gabigabou

Progamme VBA pour remplissage de cellule en couleur pour valeur famille de 1000 a 9000

Bonsoir tout le monde, j'ai grandement besoin de vous.

J'ai trois colonnes sur x lignes.
Première colonne ,j'ai un code article pouvant aller de 1000 à 1999, idem pour 2000... jusqu'à 9999.
C'est cette première colonne qui est primordiale, les deux autres sont secondaire.
Ces codes sont automatiquement classé dans l'ordre croissant.
Il me faudrait un code VBA qui me permettrai, dés lors ou il détecte une première valeur de 1000 à 1999, insérer au dessus de cette première valeur une ligne qui sera fusionnée sur l'espace des 3 cellules, dans laquelle s'écrira Famille 1000 avec une couleur par exemple rouge.
Ensuite il me créera une autre ligne des qu'il détectera une valeur 2000 à 2999, avec la aussi les trois cellules fusionnées et la valeur écrite Famille 2000 et un remplissage couleur diffèrent du premier.
Ensuite idem pour les valeur 3000...3999/4000...4999/5000...5999/6000...6999/7000...7999/8000...8999/9000...8999/9000...9000, bien sur avec une couleur de remplissage toute différente les unes des autres.
J'espère que je suis arrivé a me faire comprendre, et que vous pourrez m'aider, je suis dans la mouise:(

MERCI BEAUCOUP D'AVANCE JEGE

Bonjour,

Par exemple :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Sub test()
Dim Couleurs
Couleurs = Array(3, 6, 8, 9, 10, 11, 12, 45, 50, 56)
For i = Cells(Rows.Count, 1).End(xlUp).Row To 1 Step -1
    If i > 1 Then
        If Left(Cells(i, 1), 1) <> Left(Cells(i - 1, 1), 1) Then
            Rows(i).Insert
            Cells(i, 1).Resize(, 3).Merge
            Cells(i, 1).Value = "Famille " & Left(Cells(i + 1, 1), 1) & "000"
            Var = CInt(Left(Cells(i + 1, 1), 1))
            Cells(i, 1).Interior.ColorIndex = Application.Index(Couleurs, CInt(Left(Cells(i + 1, 1), 1)))
        End If
    Else
        Rows(1).Insert
            Cells(1, 1).Resize(, 3).Merge
            Cells(1, 1).Value = "Famille " & Left(Cells(2, 1), 1) & "000"
            Cells(i, 1).Interior.ColorIndex = Application.Index(Couleurs, CInt(Left(Cells(i + 1, 1), 1)))
    End If
Next i
End Sub

09/05/2014, 14h39
gabigabou

merci

Bonjour Daniel et merci beaucoup.

Cela fonctionne, la je dois m'absenter, je me penche sur se que tu ma fais passé des mon retour, merci beaucoup encore une fois.
09/05/2014, 23h58
gabigabou

2 pièce(s) jointe(s)

Programme VBA sur remplissage de cellules en couleur differente + titre chapitre suite

Bonsoir tout le monde, j'ai grandement besoin de vous.
Daniel.C ma envoyé un programme qui fonctionne, mais je ne suis pas allé suffisamment loin dans mes explications, donc je reviens vers vous pour un coup de main.

J'ai trois colonnes sur x lignes.
Première colonne ,j'ai un code article pouvant aller de 1000 à 1999, idem pour 2000... jusqu'à 9999.
C'est cette première colonne qui est primordiale, les deux autres sont secondaire.
Ces codes sont automatiquement classé dans l'ordre croissant.
Il me faudrait un code VBA qui me permettrai, dés lors ou il détecte une première valeur de 1000 à 1999, insérer au dessus de cette première valeur une ligne qui sera fusionnée sur l'espace des 3 cellules, dans laquelle s'écrira
CHAPITRE 1 _ ETUDES D'EXECUTION avec une couleur par exemple rouge.

Ensuite il me créera une autre ligne des qu'il détectera une valeur 2000 à 2999, avec la aussi les trois cellules fusionnées et la valeur écrite
CHAPITRE 2_PREPARATION DES CHANTIERS et un remplissage couleur diffèrent du premier, ainsi de suite.
CHAPITRE 3_LIGNES AERIENNES BT....
CHAPITRE 4_LIGNES AERINNES HTA...
.....
....
Jusqu'au CHAPITRE 13_TRAVAUX DIVERS
J'espère que je suis arrivé a me faire comprendre, et que vous pourrez m'aider, je suis dans la mouise

MERCI BEAUCOUP D'AVANCE JEGE

Je te propose ce petit bout de code :
Code:

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 Sub Titre() LigneTraitement = 1 ListeTitre = Array("Titre 1", "Titre 2", "Titre 3", "Titre 13") ValeurTitre = Array(0, 2000, 3000, 13000) CouleurTitre = Array(255, 65535, 49407, 5296274) IndexTitre = 0 While Cells(LigneTraitement, 1).Value <> "" If Cells(LigneTraitement, 1).Value >= ValeurTitre(IndexTitre) Then Rows(LigneTraitement).Insert Cells(LigneTraitement, 1).Value = ListeTitre(IndexTitre) Range(Cells(LigneTraitement, 1), Cells(LigneTraitement, 3)).Interior.Color = CouleurTitre(IndexTitre) LigneTraitement = LigneTraitement + 1 IndexTitre = IndexTitre + 1 End If LigneTraitement = LigneTraitement + 1 Wend End Sub
Avec LigneTraitement à initialiser avec la première ligne de données (1 dans mon exemple)
Cette macro s'arrètera à la première cellule vide trouvée dans la colonne 1

Le code a été écrit en supposant que tes 3 colonnes sont A, B et C
Il te suffit de remplacer et compléter les différents tableaux de données avec les bons titres (ListeTitre), les bonnes valeurs de changement de chapitre (ListeValeur) et les bonnes couleurs (CouleurTitre).
Pour trouver les bonnes valeurs de couleurs je te conseille d'enregistrer une macro sous Excel et de manuellement mettre les 13 couleurs (si 13 chapitres) dans les cellules A1 à A13.

Il te suffit ensuite de regarder le code généré et de récupérer les valeurs de propritétés ".Color" affectées à chacune des cellules (voir exemple ci-dessous de macro enregistrée automatiquement pour la courleur rouge (255))
Code:

1 2 3 4 5 6 7 8 Range("A1").Select With Selection.Interior .Pattern = xlSolid .PatternColorIndex = xlAutomatic .Color = 255 .TintAndShade = 0 .PatternTintAndShade = 0 End With
Philoul

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Explicit
 
Private Type TITRES
    TEXTE As String
    COULEUR As Long
End Type
 
Sub Chapitres()
Const PREF As String = "Chapitre "
Dim LastLig As Long, i As Long
Dim N As Byte
 
Application.ScreenUpdating = False
With Worksheets("Feuil5")                             'à adapter
    LastLig = .Cells(.Rows.Count, 1).End(xlUp).Row
    For i = LastLig To 2 Step -1
        If Not .Cells(i, 1) Like PREF & "*" And Not .Cells(i - 1, 1) Like PREF & "*" Then
            N = Int(Val(.Cells(i, 1)) / 1000)
            If Int(Val(.Cells(i - 1, 1)) / 1000) <> N Then
                .Rows(i).Insert
                With .Range("A" & i)
                    .Value = PREF & N & "_" & TitreChapitres(N).TEXTE
                    With .Resize(, 3)
                        .Merge
                        .Interior.Color = TitreChapitres(N).COULEUR
                    End With
                End With
            End If
        End If
    Next i
End With
End Sub
 
Private Function TitreChapitres(ByVal k As Byte) As TITRES
Dim TbTitres, TbCouleurs
 
TbTitres = Array("CHAP1", "CHAP2", "CHAP3", "CHAP4", "CHAP5", "CHAP6", "CHAP7", "CHAP8", "CHAP9")    'Adapte le texte des titres
TbCouleurs = Array(200, 100000, 200000, 300000, 400000, 500000, 600000, 700000, 800000)    'Adapte la couleur des titres
TitreChapitres.TEXTE = TbTitres(k - 1)
TitreChapitres.COULEUR = TbCouleurs(k - 1)
End Function

10/05/2014, 12h07
gabigabou

Pour Mercatog

Merci beaucoup cela fonctionne superbement bien.
Cependant j'ai un petit Souci sur le réglage des couleurs, je ne comprend pas la ligne
C'est du colorindex ou du RVB

TbCouleurs = Array(200, 100000, 200000, 300000, 400000, 500000, 600000, 700000, 800000) 'Adapte la couleur des titres

Une petite explication SVP
10/05/2014, 12h11
gabigabou

Pour Philou

Ton code fonctionne bien, merci beaucoup, cependant il me créé les titres dans le sens croissant, 1 pour 1000, 2 pour 2000 mais après si il y a comme dans l'exemple un passage a 9000 il crée Chap3 et non Chap9.
Cordialement
10/05/2014, 13h32
mercatog

C'est la couleur RVB (à adapter à ton besoin) J'ai pris un exemple au pif

Tu peux néanmoins travailler avec Colorindex et remplir TbCouleur en conséquence
10/05/2014, 13h37
gabigabou

Couleur pour mercatog

donc il faut autan de série de 3 valeurs RVB que de chapitre?

Array(200, 100000, 200000, 300000, 400000, 500000, 600000, 700000, 800000): la tu as mis trois couleurs?

Cordialement.
10/05/2014, 14h09
mercatog

Non
Regarde l'aide sur la fonction RGB de vba
Exemple
RGB(34,200,112) est identique à 7391266
RGB(0,0,255) est identique à 16711680

Donc tu peux utiliser RGB(r,v,b) au sein du tableau TbCouleurs ou leurs valeurs.

Tu peux aussi utiliser TbCouleurs les n° des ColorIndex et de remplasser .Interior.Color par .Interior.ColorIndex sur la ligne 25 du code précédent.

Allons, quand même
10/05/2014, 14h26
gabigabou

merci, je suis comme qui dirai novice.