[Toutes versions] Fusionner des cellules en VBA

1 pièce(s) jointe(s)

Fusionner des cellules en VBA

Bonjour,

Autodidacte dans la programmation VBA, je veux me créer un fichier Gantt.

Je rencontre une difficulté pour la fusion de cellules. Je demande à Excel une date de départ et une date de fin de projet, et j'aimerai que mes lignes 5 et 6, à partir de la colonne 6, soient automatiquement liées, avec le nom du mois.

J'ai tapé ce code :

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
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
Application.ScreenUpdating = False
 
Dim Col As Integer, Colon As Integer, DerCol As Integer, Dcol As Integer, Mois As Variant, FinMois As Variant
Dim Date_Test As Date, Date_Mois_Suivant As Date, Dernier_Jour_Mois As Date, Nbre_Jour As Integer
Dim CA As Range, Nb As Integer, Target As Range
 
    With Range("F5:ZZ6")
        .Value = ""
        .MergeCells = False
        .Interior.ThemeColor = xlNone
        .Borders(xlEdgeLeft).LineStyle = xlNone
        .Borders(xlEdgeRight).LineStyle = xlNone
        .Borders(xlEdgeTop).LineStyle = xlNone
        .Borders(xlEdgeBottom).LineStyle = xlNone
    End With
    Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column
 
    Col = 6
 
    While Col <= Dcol
 
            If Cells(11, Col) <> "" Then
 
            'Une date de la cellule
            Date_Test = CDate(Cells(11, Col))
 
            'Mois / année de la date
            Mois = Month(Date_Test)
            Annee = Year(Date_Test)
 
            'Calcul du premier jour du mois suivant
            Date_Mois_Suivant = DateSerial(Annee, Mois + 1, 1)
 
            'Date du dernier jour
            Dernier_Jour_Mois = Date_Mois_Suivant - 1
 
            'Nombre de jour dans le mois (= dernier jour)
            Nbre_Jour = Day(Dernier_Jour_Mois) - Day(Cells(11, Col))
 
            MsgBox Dernier_Jour_Mois & Chr(10) & Cells(10, Col + Nbre_Jour)
 
            Colon = Col + Nbre_Jour
            MsgBox Colon
 
            End If
 
           MsgBox Mois
           MsgBox Col
 
            Range(Cells(5, Col), Cells(6, Colon)).Select
                With Selection
 
                    .MergeCells = True
                    .HorizontalAlignment = xlCenter
                    .VerticalAlignment = xlCenter
                    .FormulaR1C1 = "=EDATE(R[6]C,0)"
                    .NumberFormat = "mmmm"
                    .Font.Size = 14
                    .Font.Bold = True
                    With Selection.Interior
                        .Pattern = xlSolid
                        .PatternColorIndex = xlAutomatic
                        .ThemeColor = xlThemeColorAccent5
                        .TintAndShade = 0.599993896298105
                        .PatternTintAndShade = 0
                    End With
                    .Borders(xlDiagonalDown).LineStyle = xlNone
                    .Borders(xlDiagonalUp).LineStyle = xlNone
                    With Selection.Borders(xlEdgeLeft)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeTop)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeBottom)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    With Selection.Borders(xlEdgeRight)
                        .LineStyle = xlContinuous
                        .ColorIndex = xlAutomatic
                        .TintAndShade = 0
                        .Weight = xlMedium
                    End With
                    Selection.Borders(xlInsideVertical).LineStyle = xlNone
                    Selection.Borders(xlInsideHorizontal).LineStyle = xlNone
 
                End With
 
           Col = Col + Colon - 5
 
    Wend
 
 
    Range("C3:E7").Select
    Selection.Borders(xlDiagonalDown).LineStyle = xlNone
    Selection.Borders(xlDiagonalUp).LineStyle = xlNone
    With Selection.Borders(xlEdgeLeft)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeTop)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeBottom)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
    With Selection.Borders(xlEdgeRight)
        .LineStyle = xlContinuous
        .ColorIndex = xlAutomatic
        .TintAndShade = 0
        .Weight = xlMedium
    End With
 
Application.ScreenUpdating = True

Pour tester, j'ai pris une année complète. Or, quand je lance la macro, les colonnes F à AJ (mois de Janvier) sont correctement fusionnées. Les colonnes AK à BM (mois de Février) sont correctement fusionnées.
Puis, je passe aux colonnes CS à DV (mois d'Avril) puis les cellules HJ5 et HJ6 qui correspondent au 31 juillet.

Je ne comprends pas pourquoi cette macro ne me fusionne pas correctement les cellules pour chaque mois (c'est ce que je demande pour les lignes 5 et 6 à partir de la colonne 6)

Si quelqu'un peut m'aider à résoudre ce problème, merci par avance à lui

la macro est sur la feuille 1 dans le fichier joint sous le nom Private Sub Worksheet_Activate()

Petit rectificatif dans le code,

ligne 16, il faut lire :

Code:

Dcol = Cells(11, Cells.Columns.Count).End(xlToLeft).Column

et non pas

Code:

Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column

Bonjour,

Citation:

Envoyé par Ugodelires

Je ne comprends pas pourquoi cette macro ne me fusionne pas correctement les cellules pour chaque mois

Ton problème vient sans doute de ces 2 lignes qui aboutissent à des valeurs totalement incohérentes
Code:

1 2 3 Colon = Col + Nbre_Jour ... Col = Col + Colon - 5

Bonjour anasecu,

Effectivement, c'est col=colon+1 et non pas Col = Col + Colon - 5

Et voilà ça marche nickel comme celà.

Merci à toi pour ce petit aiguillage