ajouter une ligne de separation

**target111** · 02/06/2012, 02h43

bonjour

j'aurais besoin d'une petite aide

voila je voudrais dans la colonne D séparer chaque fournisseur par une ligne
qui aurai une hauteur de 5 et cette ligne aurai une couleur noire sur les cellules b c d w x j'ai essayé ce code

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
Public Sub test()
Dim i As Long
Dim truc As Range
Set truc = Range("d1")
i = 1
With truc
While .Cells(i) <> Empty
If .Cells(i) = .Cells(i + 1) Then
i = i + 1
Else
.Cells(i + 1).EntireRow.Insert Shift:=xlDown
i = i + 2
End If
Wend
End With
End Sub

je n'aie pas intégré la couleur étant débutant en vba et je n'obtiens pas le résultat voulu

merci de votre aide

Cordialement

**gFZT82** · 02/06/2012, 07h13

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Option Explicit
Sub test()
Dim DerLig As Long, i As Long
    With Worksheets("Feuil1") 'A adapter
        DerLig = .Range("D" & .Rows.Count).End(xlUp).Row
        For i = DerLig To 3 Step -1
            If .Cells(i, 4) <> "" And .Cells(i - 1, 4) <> "" Then
                If .Cells(i, 4) <> .Cells(i - 1, 4) Then
                    .Rows(i).Insert Shift:=xlDown
                    .Rows(i).RowHeight = 5
                    .Range(.Cells(i, 2), .Cells(i, 4)).Interior.ColorIndex = 1
                    .Range(.Cells(i, 23), .Cells(i, 24)).Interior.ColorIndex = 1
                End If
            End If
        Next
    End With
End Sub

Cordialement.

**target111** · 05/06/2012, 03h40

bonjour

je viens de tester le code et voila ce que j'optiens

et je voudrais optenir ceci

voici le code complet que j'ai fais en appuyant sur un bouton qui ce nomme "MASQUE FINAL" j'apelle la routine "Format_Masquer_Colonnes" et je voudrai ci cela est possible optenir un résultat comme l'image si dessus

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
Sub Format_Masquer_Colonnes()
'**********************************
'EMPECHE LE DÉFFILEMENT INTEMPESTIF
'**********************************
Application.ScreenUpdating = False
'**********************************
'EMPECHE LE DÉFFILEMENT INTEMPESTIF
'**********************************
Sheets("Achats").Unprotect Password:="target"
'****************************************
'LARGEUR DES COLONNES "B" "C" "D" "S" "T"
'****************************************
    Columns("B:B").ColumnWidth = 8.43
    Columns("C:C").ColumnWidth = 43.29
    Columns("D:D").ColumnWidth = 12.29
    Columns("W:W").ColumnWidth = 7.57
    Columns("X:X").ColumnWidth = 25.57
    ActiveWindow.SmallScroll Down:=60
    Call Masque_Final 'MEME MODULE "Masque_Finale_10"
    Call Format 'MEME MODULE "Masque_Finale_10"
    Call Masquer_Lignes 'MEME MODULE "Masque_Finale_10"
'**********************************
'TITRES DE LA CELLULES "C1" EN GRAS
'**********************************
Range("C1").Select
Selection.Font.Bold = True
'***************************
'MET CURSEUR DANS CELLULE S2
'***************************
Range("S2").Select
End Sub
 
Sub Masque_Final()
'**********************************
'CACHE LES COLONNES H K L M O P T V
'**********************************
    Range("H:H,K:K,L:L,M:M,O:O,P:P,S:S,T:T,V:V").Select
    Selection.EntireColumn.Hidden = True
 
'**********************************
'CACHE LES COLONNES Y Z AG AH AI AJ
'**********************************
   Range("Y:Y,Z:Z,AG:AG,AH:AH,AI:AI,AJ:AJ").Select
   Selection.EntireColumn.Hidden = True
   Sheets("Achats").Unprotect Password:="target"
End Sub
 
Sub Format()
 Range("B2").Select
    Selection.Copy
    Range("C2:C600").Select
    Selection.PasteSpecial Paste:=xlPasteFormats, Operation:=xlNone, _
        SkipBlanks:=False, Transpose:=False
    Application.CutCopyMode = False
    Range("C2:C600").Select
    With Selection
        .HorizontalAlignment = xlLeft
    End With
 
End Sub
 
Sub Masquer_Lignes()
'*********************************************
'ÉFFACE LES CELLULES VIDES DE LA COLONNE ACHAT
'*********************************************
Dim i As Long
 For i = 1 To ActiveSheet.UsedRange.Rows.Count
 If Cells(i, 23) = 0 Then Rows(i).RowHeight = 0
 Next
  Rows("7:7").Select
    Range("B7").Activate
ActiveWindow.FreezePanes = True 'active volets
 
'****************************
'ÉFFACE LES 3 PREMIÉRES LIGNE
'****************************
Call Supression_Ligne 'MODULE "Insertion_Supression_Lignes"
 
'******************
'MASQUE LES BOUTONS
'******************
Call Boutons_Non_Visible 'MODULE "Afficher_Masquer_Boutons"
 
'*********************************************************
' MASQUE BOUTONS "AFFICHER COLONNES" DANS FEUILLE D'ACHATS
'*********************************************************
Call Boutons_Non_Visible_2 'MODULE "Afficher_Masquer_Boutons"
 
'************************************************
'Call Deprotege_Achat DÉPROTÉGE FEUILLE D'ACHATS
'************************************************
Call Deprotege_Achat 'MODULE "Déprotege_Protege_Achats_11"
 
'****************************
'ÉFFACE COULEUR COLONNE B C D
'****************************
Range("B:B,C:C,D:D").Select
    Range("D1").Activate
    Selection.Interior.ColorIndex = xlNone
 
'*****************************************
'ÉFFACE FORMAT CONDITIONNEL COLONNE B ET W
'*****************************************
Range("B2:B600").Select
Selection.FormatConditions.Delete
Range("W2:W600").Select
Selection.FormatConditions.Delete
 
'*****************************************************
'MISE EN PLACE DE LA BORDURES DANS COLONNE "B C D W X"
'*****************************************************
Worksheets(2).Range("B:B,C:C,D:D,W:W,X:X").Borders.LineStyle = xlContinuous
 
Call test
 
End Sub
 
Option Explicit
Sub test()
Dim DerLig As Long, i As Long
    With Worksheets("Feuil1") 'A adapter
        DerLig = .Range("D" & .Rows.Count).End(xlUp).Row
        For i = DerLig To 3 Step -1
            If .Cells(i, 4) <> "" And .Cells(i - 1, 4) <> "" Then
                If .Cells(i, 4) <> .Cells(i - 1, 4) Then
                    .Rows(i).Insert Shift:=xlDown
                    .Rows(i).RowHeight = 5
                    .Range(.Cells(i, 2), .Cells(i, 4)).Interior.ColorIndex = 1
                    .Range(.Cells(i, 23), .Cells(i, 24)).Interior.ColorIndex = 1
                End If
            End If
        Next
    End With
End Sub

Merci d'avance pour votre aide

Cordialement

**gFZT82** · 05/06/2012, 08h44

Bonjour,

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
If .Cells(i, 4) <> "" And .Cells(i - 1, 4) <> "" Then
                If .Cells(i, 4) <> .Cells(i - 1, 4) Then

Le code effectue une comparaison 2 à 2 des cellules de la colonne D.
Pour qu’une ligne noire soit insérée, il faut que les 2 cellules soient différentes et qu’aucune ne soit vide.
Je ne vois pas ce qui provoque cette multitude d'insertion de lignes noires.
Tu peux envoyer un morceau de fichier en exemple ?

**target111** · 05/06/2012, 17h20

bonjour

merci de ton aide elle met précieuse

j'ai joins mon fichier à l'ouverture tu vas tomber sur la feuille principale avec 2 boutons au centre et un 3 eme en haut à gauche tout petit c'est sur celui là qu'il faut cliquer sur la feuille qui s'ouvre il faut cliquer sur le bouton MASQUE FINALE le code rataché à ce bouton et le module "Masque_Finale_10"

encore merci de ton aide

Cordialement

**gFZT82** · 05/06/2012, 18h02

Bonjour,

Essaie comme cela

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
Sub test()
Dim DerLig As Long, i As Long
    With Worksheets("Achats") 'A adapter
        .Cells.RowHeight = 15
        DerLig = .Range("D" & .Rows.Count).End(xlUp).Row
        For i = DerLig To 3 Step -1
            If .Cells(i, 4) <> "" And .Cells(i - 1, 4) <> "" Then
                If .Cells(i, 4) <> .Cells(i - 1, 4) Then
                    .Rows(i).Insert Shift:=xlDown
                    .Rows(i).RowHeight = 5
                    .Range(.Cells(i, 2), .Cells(i, 4)).Interior.ColorIndex = 1
                    .Range(.Cells(i, 23), .Cells(i, 24)).Interior.ColorIndex = 1
                End If
            End If
        Next
    End With
End Sub

Cordialement.

**target111** · 09/06/2012, 02h09

Bonjour

Merci pour ta réponse mais surtout pour ton aide
le code fonctionne super bien

Merci encore

Cordialement

ajouter une ligne de separation

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager