IdentifiantMot de passe
Loading...
Mot de passe oublié ?Je m'inscris ! (gratuit)
Navigation

Inscrivez-vous gratuitement
pour pouvoir participer, suivre les réponses en temps réel, voter pour les messages, poser vos propres questions et recevoir la newsletter

Macros et VBA Excel Discussion :

Fusionner des cellules en VBA [Toutes versions]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre à l'essai
    Homme Profil pro
    Responsable Entrepôt Logistique
    Inscrit en
    Novembre 2017
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Entrepôt Logistique
    Secteur : Transports

    Informations forums :
    Inscription : Novembre 2017
    Messages : 3
    Par défaut 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 : 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
    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()
    Fichiers attachés Fichiers attachés

  2. #2
    Membre à l'essai
    Homme Profil pro
    Responsable Entrepôt Logistique
    Inscrit en
    Novembre 2017
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Entrepôt Logistique
    Secteur : Transports

    Informations forums :
    Inscription : Novembre 2017
    Messages : 3
    Par défaut
    Petit rectificatif dans le code,

    ligne 16, il faut lire :
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dcol = Cells(11, Cells.Columns.Count).End(xlToLeft).Column
    et non pas
    Code : Sélectionner tout - Visualiser dans une fenêtre à part
    Dcol = Cells(10, Cells.Columns.Count).End(xlToLeft).Column

  3. #3
    Membre Expert
    Inscrit en
    Septembre 2007
    Messages
    1 142
    Détails du profil
    Informations forums :
    Inscription : Septembre 2007
    Messages : 1 142
    Par défaut
    Bonjour,
    Citation Envoyé par Ugodelires Voir le message
    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 : Sélectionner tout - Visualiser dans une fenêtre à part
    1
    2
    3
     Colon = Col + Nbre_Jour
    ...
     Col = Col + Colon - 5

  4. #4
    Membre à l'essai
    Homme Profil pro
    Responsable Entrepôt Logistique
    Inscrit en
    Novembre 2017
    Messages
    3
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 50
    Localisation : France, Calvados (Basse Normandie)

    Informations professionnelles :
    Activité : Responsable Entrepôt Logistique
    Secteur : Transports

    Informations forums :
    Inscription : Novembre 2017
    Messages : 3
    Par défaut
    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

+ Répondre à la discussion
Cette discussion est résolue.

Discussions similaires

  1. [XL-2010] Fusionner des cellules si y a pas de bordure entre elles en utilisant une macro (VBA)
    Par mounder mel dans le forum Macros et VBA Excel
    Réponses: 13
    Dernier message: 08/02/2018, 09h21
  2. Réponses: 2
    Dernier message: 06/03/2017, 20h51
  3. Macro vba pour fusionner des cellules
    Par Ioro_ dans le forum Macros et VBA Excel
    Réponses: 8
    Dernier message: 09/03/2016, 17h57
  4. Fusionner des cellules et nombre de lignes variables VBA
    Par hugohours1993 dans le forum Macros et VBA Excel
    Réponses: 3
    Dernier message: 24/02/2016, 11h06
  5. [XL-2007] VBA - fusionner des cellules sous feuille protégée
    Par LaMite dans le forum Macros et VBA Excel
    Réponses: 0
    Dernier message: 16/04/2014, 09h28

Partager

Partager
  • Envoyer la discussion sur Viadeo
  • Envoyer la discussion sur Twitter
  • Envoyer la discussion sur Google
  • Envoyer la discussion sur Facebook
  • Envoyer la discussion sur Digg
  • Envoyer la discussion sur Delicious
  • Envoyer la discussion sur MySpace
  • Envoyer la discussion sur Yahoo