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 |
