Programme VBA pour confection tableau avec n°article en reference

Version imprimable

11/05/2014, 11h47
gabigabou

2 pièce(s) jointe(s)

Programme VBA pour confection tableau avec n°article en reference

Pièce jointe 145493Pièce jointe 145494
Bonjour tout le monde, j'ai encore grandement besoin de vous.

Le programme qui ma été donné par mercatog fonctionne très bien ainsi que les explications, merci encore.

Maintenant le tableau suivant est plus complexe.
Je vous joint 2 captures écran qui devraient vous aidé à mieux me comprendre.

J'ai à la base 6 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, la quatrième étant les quantités.
Ces codes sont automatiquement classés 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 de 6 cellules, dans laquelle s'écrira
CHAPITRE 1 _ ETUDES D'EXECUTION sans couleur de remplissage.
Que les valeurs de 1000 à 1999 détectées soient avec une couleur de remplissage choisie.
Que pour le code article détecté ex 1010, soit écrit dans la colonne Désignation des travaux: Ligne BT posée sur façade, dans la colonne Unité: ML, dans la colonne Prix unitaire HT: 3,10 et qu'il me fasse le calcul de la ligne dans la colonne total
Qu'a la fin de la série d'article 1000 à 1999 il insère une ligne en fusionnant les deux dernière cellule, la aussi avec couleur remplissage au choix, et en écrivant total: avec la somme des totaux de la séries des 1000 à 1999.
Tous les codes articles et désignations ne sont pas présent ici, je les compléterai dans le programme, cela serait trop long de vous les donner, mais si vous pouviez m'établir le programme avec les infos données je compléterai avec les autres.

Ensuite idem pour les autres chapitres avec une couleur de remplissage des n° articles différent au choix
CHAPITRE 2_PREPARATION DES CHANTIERS
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 vraiment dans la mouise et pas expérimenté pour me débrouillé tout seul.

MERCI BEAUCOUP D'AVANCE JEGE
11/05/2014, 12h52
mercatog

Les informations des désignations, unités,... devraient exister quelque part (saisies par les utilisateurs)?
11/05/2014, 19h58
gabigabou

Bonsoir.

J'utilise un logiciel de conception de réseau elec souterrain et aérien avec du matériel paramétrés sur comme on dit un catalogue.
Ce catalogue ne permet pas d'avoir ce type de désignation, d'unité, de prix unitaire, c'est pour cela que je voudrais les stocker (si je peux dire comme cela) dans le code VBA, et a la fin il n'y ai qu'un contrôle du dessinateur pour éviter des erreurs.

Penses tu que cela soit réalisable sous le même principe que tu ma donner, certes cela doit être plus long, mais d'une année sur l'autre on pourra modifier les tarif voir les désignations.

Cordialement.
11/05/2014, 20h47
mercatog

Mauvais idée d'inscrire des données variables en dur dans un code vba!
11/05/2014, 23h24
gabigabou

Quels conseils pourrais tu me donner?

Je peux, je pense que cela sera la seule faisable, mettre la valeur des unités (m², m³, U, Kg.....) dans un champ nature.

Comme je disais tout a l'heure j'utilise un logiciel de conception des réseaux électriques que je paramètre, les paramètres étant restreins.
Ce logiciel une fois la conception faite, fait une purge de l'étude et me rassemble tous les éléments dans un classeur à plusieurs feuilles.
C'est pour cela que les éléments de références sont les n° articles et les quantités, puisque se sont les éléments que je peux paramétrer, mais pas les autres.
C'est pour cela que je souhaiterai les avoir sur le programme, pour éviter toutes manip supplémentaire à faire a la fin, pour éventuellement éviter toutes erreur comme on dit de saisie et n'avoir qu'une action de contrôle donc un gain de temps en productivité.
Juste sur le programme, une fois par an régler les prix, voir les unités, les désignations.
Pouvez vous m'aider, es que cela est réalisable?
J'ai besoin d'un énorme coup de main, la hiérarchie me fixe des objectifs sans financement de formation, donc je suis bloqué!
Cordialement.
11/05/2014, 23h44
mercatog

Au lieu de les écrire en dur sur le code, il suffit de les saisir une fois pour tout sur une feuille avec comme clé le n° article et d'éventuellement cacher cette feuille (pour ne pas risquer de mauvaises manipulations)
12/05/2014, 00h35
gabigabou

Tu peux me faire un exemple avec les éléments que je t'ai fourni sur les captures écran.
Je ne vois pas comment faire.
Et également, comment peux tu protéger la feuille?

Pour mettre les couleurs dans les colonnes des séries des n° articles, tu as le code VBA?
Le code pour le remplissage des couleurs en ligne sur les chapitres est super mais je ne vois pas comment les appliquer en colonnes.

Cordialement.

Programme VBA

Re bonsoir.

Le Programme de Mercatog est ni quel pour l'insertion des lignes de titre avec le remplissage avec une couleur différente pour chaque titre, mais j'ai beau réfléchir, pas suffisamment d'expérience en la matière, je n'arrive pas a réutiliser son programme pour faire en sorte que cela soit la colonne des codes article série des 1000 qui se met d'une couleur les 2000 d'une autre couleur ainsi de suite.
Et la mise en forme des lignes de chapitre sans couleur.

Aidez moi s'il vous plait!!!!!!!!! merci.

Cordialement GEGE

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

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
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
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, Cpt As Long
Dim MesTitres As TITRES
Dim N As Byte
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")                             'à 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 N <> 0 Then
                If Int(Val(.Cells(i - 1, 1)) / 1000) <> N Then
                    MesTitres = TitreChapitres(N)
                    .Rows(i).Insert
                    With .Range("A" & i)
                        .Value = UCase(PREF & N & "_" & MesTitres.TEXTE)
                        .Resize(, 6).Merge
                        With .Font
                            .Bold = True
                            .Size = 13
                        End With
                        .Offset(Cpt + 2).EntireRow.Insert
                        .Offset(1).Resize(Cpt + 1).Interior.ColorIndex = MesTitres.COULEUR
 
                    End With
                    With .Range("E" & i + Cpt + 2).Resize(, 2)
                        .Merge
                        .Formula = "=""TOTAL: ""&SUM(F" & i + 1 & ":F" & i + 1 + Cpt & ")"
                        With .Font
                            .Bold = True
                            .Size = 12
                        End With
                        With .Borders
                            .LineStyle = xlContinuous
                            .Weight = xlMedium
                        End With
                    End With
                    .Range("F" & i + 1 & ":F" & i + 1 + Cpt).FormulaR1C1 = "=RC[-2]*RC[-1]"
                    Cpt = 0
                Else
                    Cpt = Cpt + 1
                End If
            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(44, 5, 12, 27, 14, 34, 22, 41, 17)    'Adapte les index de couleur des groupes
TitreChapitres.TEXTE = TbTitres(k - 1)
TitreChapitres.COULEUR = TbCouleurs(k - 1)
End Function