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 automatiquement des cellules [XL-365]


Sujet :

Macros et VBA Excel

Vue hybride

Message précédent Message précédent   Message suivant Message suivant
  1. #1
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut fusionner automatiquement des cellules
    Bonjour et tout d'abord merci à vous tous. Je débute dans l'univers du code VBA et je peux déjà vous dire que ce Forum m'a permis d'avancer vite sur mon projet. Ma question :
    Ce que j'aimerai pouvoir faire à l'aide d'un code VBA :
    (ordre traduit dans mes mots...)

    inspecte les cellules d'une colonne (fixe), partir de la 5ème ligne,
    si la valeur d'une cellule au dessus est la même, fusionne ces deux cellules ensemble
    descends encore
    répète l'opération
    arrête au bout de 6 lignes.
    Puis le même code mais cette fois en ne s'arrêtant qu'a la première cellule vide.
    Je me suis lancé dans un projet ambitieux, j'avance grâce à ce genre de forums, mais ne pouvant tout apprendre d'un coup je voudrais finir cette étape pour me consacrer au reste.
    Encore merci pour ce précieux forum !

  2. #2
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour et bienvenue sur le forum,

    Puisque tu as exploré une partie de ce forum, si tu fais une rechercher sur "fusionner des cellules", tu constateras que la majorité d'entre nous répondent que c'est une très mauvaise idée que fusionner les cellules.

  3. #3
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut
    Citation Envoyé par Patrice740 Voir le message
    Bonjour et bienvenue sur le forum,

    Puisque tu as exploré une partie de ce forum, si tu fais une rechercher sur "fusionner des cellules", tu constateras que la majorité d'entre nous répondent que c'est une très mauvaise idée que fusionner les cellules.
    Oui j'en ai bien conscience. Dans ce cas ca ne pose aucun soucis, il s'agit juste du rendu qui sera imprimé et qui nécessite cette opération. Dans tout le reste du fichier, rien n'est fusionné (j'ai bien lu les conseils) et tout fonctionne très bien.

  4. #4
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Citation Envoyé par fawgood Voir le message
    Oui j'en ai bien conscience. Dans ce cas ca ne pose aucun soucis, il s'agit juste du rendu qui sera imprimé et qui nécessite cette opération. Dans tout le reste du fichier, rien n'est fusionné (j'ai bien lu les conseils) et tout fonctionne très bien.
    Deux screens (avant / après) seraient les bienvenus

  5. #5
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut fusionner c'est pas bien mais parfois c'est joli
    Citation Envoyé par Patrice740 Voir le message
    Deux screens (avant / après) seraient les bienvenus
    Merci pour l'intérêt suscité.
    Je joins en pdf la version du tableau à imprimer une fois que je lui ai chargé toutes les données. Elles proviennent de la base de données que j'ai créé, elles ont déjà été filtrées (n'apparaissent que les références que j'ai sélectionné, dont le stock est >0, pour lesquelles je dispose de toutes les infos validées)
    ensuite je joins le fichier que j'aimerai imprimer après modifications (je bosse encore sur les détails de la mise en page).
    Je sais qu'excel n'est pas un outil d'édition de documents, je prévois de m'atteler à relier ceci à un outil plus adapté (Word...) mais pour le moment si je peux obtenir ce résultat sans avoir à modifier manuellement je serais ravi.

    merci encore
    Images attachées Images attachées

  6. #6
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Un pdf c'est pas un screen (une copie d'écran) : on ne voit pas les numéros de lignes et de colonnes !

    En supposant que le tableau commence en A4 (les titres sont sur la ligne 4 et la ligne 3 est vide), que la feuille s'appelle "Feuil1" et qu'il y a 39 lignes de données par page à imprimer (ça fait beaucoup de suppositions !):
    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
    Option Explicit
    Sub Fusionner()
    Dim rng As Range
    Dim noL As Long, nL1 As Long, nL2 As Long, nbL As Integer
    Dim valC1, valC2
    Const nLP% = 39
      ' Tableau
      Set rng = Worksheets("Feuil1").Range("A4").CurrentRegion
      ' Plage des données (Tableau sauf titres)
      Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
      ' Analyse des données ligne à ligne
      valC1 = rng(1, 1).Value: nL1 = 1
      valC2 = rng(1, 2).Value: nL2 = 1
      For noL = 1 To rng.Rows.Count
        ' nombre de lignes de la page
        nbL = nbL + 1
        If nbL = nLP Then
          ' fin de page
          Application.DisplayAlerts = False
          With rng(nL1, 1).Resize(noL + 1 - nL1)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          With rng(nL2, 2).Resize(noL + 1 - nL2)
            .MergeCells = True
            .VerticalAlignment = xlCenter
          End With
          Application.DisplayAlerts = True
          valC1 = rng(noL + 1, 1)
          nL1 = noL + 1
          valC2 = rng(noL + 1, 2)
          nL2 = noL + 1
          nbL = 0
        End If
        If rng(noL + 1, 1).Value <> valC1 Then
          ' fin de plage à fusionner colonne 1
          Application.DisplayAlerts = False
          With rng(nL1, 1).Resize(noL + 1 - nL1)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          Application.DisplayAlerts = True
          valC1 = rng(noL + 1, 1)
          nL1 = noL + 1
        End If
        If rng(noL + 1, 2).Value <> valC2 Or rng(noL + 1, 1).Value <> valC1 Then
          ' fin de plage à fusionner colonne 2
          Application.DisplayAlerts = False
          With rng(nL2, 2).Resize(noL + 1 - nL2)
            .MergeCells = True
            .VerticalAlignment = xlCenter
          End With
          Application.DisplayAlerts = True
          valC2 = rng(noL + 1, 2)
          nL2 = noL + 1
        End If
      Next noL
    End Sub

  7. #7
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut
    Citation Envoyé par Patrice740 Voir le message
    Bonjour,

    Un pdf c'est pas un screen (une copie d'écran) : on ne voit pas les numéros de lignes et de colonnes !
    (...)
    [/CODE]
    Merci beaucoup !
    Je comprendrai mieux l'intérêt du screen, j'ai bêtement pensé que le résultat final étant voué à impressoin, un pdf serait suffisant.
    Mon tableau commencera donc en colonne A (mais les fusions se feront en colonnes B; C; D) et comportera 39 lignes / page (ceci peut s'adapter car je n'ai pas encore défini les marges d'impressions et le format des lignes).
    Je testerai votre code un petit peu plus tard car il me reste encore quelques macros à créer pour finaliser mon projet. Je vous ferai un retour.
    je vais aussi prendre le temps de décortiquer et comprendre afin d'être capable de reproduire ou adapter.
    Seulement une semaine de code VBA pour moi et malgré mon enthousiasme, il reste un tas de choses à apprendre.
    MERCI ENCORE POUR TOUT !

  8. #8
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut Merci pour les efforts mais...
    Citation Envoyé par Patrice740 Voir le message
    Bonjour,



    En supposant que le tableau commence en A4 (les titres sont sur la ligne 4 et la ligne 3 est vide), que la feuille s'appelle "Feuil1" et qu'il y a 39 lignes de données par page à imprimer (ça fait beaucoup de suppositions !)
    Voilà
    j'ai testé et obtenu un message d'erreur :

    *****Erreur d'execution'1004': impossible de définir la propriéte mergecells de la classe range****
    je joins une capture d'écran de la feuille avant modification
    j'ai revu la mise en page pour correspondre aux indications du code mais peut être ai je mal compris le code
    je redonne donc des indications :
    la feuille se nomme "ROUGES"
    le tableau se nomme "TABCARTE"
    les 3 premières lignes sont vides (ou contiennent le titre)
    l'en tête du tableau est sur la ligne 4
    je souhaite fusionner principalement sur les colonnes, A B et C
    j'ai placé la fin de zone d'impression de manière à ce que 38 références (donc lignes de tableau hors en tête) soient imprimées.

    Bien sûr je comprendrais que je doive modifier ma demande si celle ci est impossible et ne pas coder cette procédure.

    merci encore pour le temps passé.
    Images attachées Images attachées   

  9. #9
    Expert confirmé Avatar de Patrice740
    Homme Profil pro
    Retraité
    Inscrit en
    Mars 2007
    Messages
    2 478
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Âge : 71
    Localisation : France, Gironde (Aquitaine)

    Informations professionnelles :
    Activité : Retraité
    Secteur : Aéronautique - Marine - Espace - Armement

    Informations forums :
    Inscription : Mars 2007
    Messages : 2 478
    Par défaut
    Bonjour,

    Avec ces précision c'est bien mieux :
    il n'est pas possible de fusionner des cellules dans un tableau structuré.

    Pour ne pas détruire le tableau, je te propose donc de le faire dans la feuille d'un classeur temporaire que tu pourras enregistrer au format pdf
    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
    Option Explicit
    Sub Fusionner()
    Dim wbk As Workbook, wsh As Worksheet, rng As Range
    Dim noL As Long, nL1 As Long, nL2 As Long, nL3 As Long, nbL As Integer
    Dim valC1, valC2, valC3
    Const nLP% = 39  ' nombre de lignes de données par page
      ' Créer une copie de la feuille dans un fichier temporaire
      ThisWorkbook.Worksheets("ROUGES").Copy
      Set wbk = ActiveWorkbook
      Set wsh = wbk.Worksheets(1)
      ' Convertir le tableau en plage
      wsh.ListObjects(1).Unlist
      ' Plage
      Set rng = wsh.Range("A4").CurrentRegion
      ' Plage des données (Plage sauf titres)
      Set rng = rng.Offset(1).Resize(rng.Rows.Count - 1)
      ' Analyse des données ligne à ligne
      valC1 = rng(1, 1).Value: nL1 = 1
      valC2 = rng(1, 2).Value: nL2 = 1
      valC3 = rng(1, 3).Value: nL3 = 1
      For noL = 1 To rng.Rows.Count
        ' nombre de lignes de la page
        nbL = nbL + 1
        If nbL = nLP Then
          ' fin de page
          Application.DisplayAlerts = False
          With rng(nL1, 1).Resize(noL + 1 - nL1)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          With rng(nL2, 2).Resize(noL + 1 - nL2)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          With rng(nL3, 3).Resize(noL + 1 - nL3)
            .MergeCells = True
            .VerticalAlignment = xlCenter
          End With
          Application.DisplayAlerts = True
          valC1 = rng(noL + 1, 1): nL1 = noL + 1
          valC2 = rng(noL + 1, 2): nL2 = noL + 1
          valC3 = rng(noL + 1, 3): nL3 = noL + 1
          nbL = 0
        End If
        If rng(noL + 1, 1).Value <> valC1 Then
          ' fin de plage à fusionner colonne 1
          Application.DisplayAlerts = False
          With rng(nL1, 1).Resize(noL + 1 - nL1)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          Application.DisplayAlerts = True
          valC1 = rng(noL + 1, 1): nL1 = noL + 1
        End If
        If rng(noL + 1, 2).Value <> valC2 Or _
           rng(noL + 1, 1).Value <> valC1 Then
          ' fin de plage à fusionner colonne 2
          Application.DisplayAlerts = False
          With rng(nL2, 2).Resize(noL + 1 - nL2)
            .MergeCells = True
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
            .WrapText = True
            .Orientation = 90
          End With
          Application.DisplayAlerts = True
          valC2 = rng(noL + 1, 2): nL2 = noL + 1
        End If
        If rng(noL + 1, 3).Value <> valC3 Or _
           rng(noL + 1, 2).Value <> valC2 Or _
           rng(noL + 1, 1).Value <> valC1 Then
          ' fin de plage à fusionner colonne 2
          Application.DisplayAlerts = False
          With rng(nL3, 3).Resize(noL + 1 - nL3)
            .MergeCells = True
            .VerticalAlignment = xlCenter
          End With
          Application.DisplayAlerts = True
          valC3 = rng(noL + 1, 3): nL3 = noL + 1
        End If
      Next noL
    End Sub

  10. #10
    Membre régulier
    Homme Profil pro
    sommelier
    Inscrit en
    Décembre 2020
    Messages
    8
    Détails du profil
    Informations personnelles :
    Sexe : Homme
    Localisation : France, Marne (Champagne Ardenne)

    Informations professionnelles :
    Activité : sommelier

    Informations forums :
    Inscription : Décembre 2020
    Messages : 8
    Par défaut
    Citation Envoyé par Patrice740 Voir le message
    Bonjour,

    Avec ces précision c'est bien mieux :
    il n'est pas possible de fusionner des cellules dans un tableau structuré.
    (...)
    Le code fonctionne parfaitement. j'ai pu m'en servir et même l'adapter pour chacune des régions viticoles en l'ensemble de ma base de donnée.
    C'est un grand merci car si le plus important était pour moi de pouvoir gérer les stocks, le fait de pouvoir aussi éditer les documents en les reliant à la bdd était un véritable plus.
    encore une fois merci merci merci

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

Discussions similaires

  1. Fusionner automatiquement des cellules
    Par Invité dans le forum Programmation (La)TeX avancée
    Réponses: 5
    Dernier message: 21/01/2014, 22h30
  2. [XL-2007] Copier/coller automatiquement des cellules
    Par PapaOurs79 dans le forum Macros et VBA Excel
    Réponses: 2
    Dernier message: 18/01/2011, 17h23
  3. Réponses: 6
    Dernier message: 12/03/2009, 14h07
  4. Verrouillage automatique des cellules
    Par Stradi_v dans le forum Excel
    Réponses: 2
    Dernier message: 03/06/2008, 14h51
  5. [VBA] [EXCEL 97] Formatage automatique des cellules
    Par plante20100 dans le forum Macros et VBA Excel
    Réponses: 1
    Dernier message: 21/09/2005, 09h49

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