Probleme de fusion de cell en VBA

Le 20/08/2020 à 13:36

Bonjour,

je vous contacte car souhaiterait ajouter un système de fusion de cellules pour pouvoir générer un pdf correct mais mon code semble avoir quelques soucis

En effet je tente d'afficher les work-packages d'un projet et le tout commençant à la ligne 50

si mon résultat i = 1 alors cela fonctionne correctement et me fusionne les colonnes de B à H de la ligne concernée

toutefois pur les résultat autre que 1 (else) cela bug totalement

en effet la fusion n'est pas correctement interprétée.

j'ai du faire cela en deux étapes

car

de ligne 50 à 51 1 wP

de ligne 52 à 53 2eme WP

etc.

si quelqu'un pouvait m'aider ca serait top!

For i = 1 To Count_wp
ligne = 49 + i
If (i <= Count_wp) Then

If (i = 1) Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne, 1), Cells(ligne + 1, 1)).Merge
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne, 2), Cells(ligne + 1, 8)).Merge

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2)

If (WP_Array.Cells(i, 9) = "Lead") Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne).Font.Color = RGB(255, 0, 0)
ElseIf (WP_Array.Cells(i, 9) = "Partner") Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Ralnge("B" & ligne).Font.Color = RGB(0, 0, 255)
End If
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)

Else

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(i + 50, 1), Cells(i + 50 + 1, 1)).Merge
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(i + 50, 2), Cells(i + 50 + 1, 8)).Merge

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & i + 50) = "WP " & WP_Array.Cells(i, 2)

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & i + 50) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)
End If
End If
Next
Le 20/08/2020 à 15:42

Bonjour,

Je pense que votre problème réside dans l'affectation de ligne (on s'y retrouve moins facilement). Vous devriez peut-être écrire ligne = i + quelchose en fonction des conditions ou créer 2 variables ligne et lignesup.

Mais surtout, quand i <> 1 la boucle se retrouve à devoir fusionner avec la ligne suivante une cellule déjà fusionnée avec la ligne précédente.

Il faudrait éventuellement gérer la parité avec un if not i mod 2 = 0 (si i impair) => fusion, sinon pas de fusion.

Le 20/08/2020 à 16:01

J'ai essayé quelque chose, est-ce que ce code vous parle ?

With Workbooks(Acronym & ".xlsm").Worksheets("Feuil1")

For i = 1 To Count_wp

ligne = 49 + i

If i = 1 Then 'si i=1, mise en forme sous condition
  If WP_Array.Cells(i, 9) = "Lead" Then
        .Range("B" & ligne).Font.Color = RGB(255, 0, 0)
  ElseIf WP_Array.Cells(i, 9) = "Partner" Then
        .Range("B" & ligne).Font.Color = RGB(0, 0, 255)
End If

If ligne mod 2 = 0  then 'si ligne est paire
    .Range(Cells(ligne, 1), Cells(ligne + 1, 1)).Merge 'fusionne
    .Range(Cells(ligne, 2), Cells(ligne + 1, 8)).Merge
    .Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
end if

.Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9) 'Bligne (sans fusion) mouvementé à chaque i

Next i

end with
Le 20/08/2020 à 16:19

bonjour et merci à vous pour ce code qui semble fonctionner pour la fusion

cependant l'affichage des résultats est incorrect car saute des résultats ..

est il par ailleurs possible de forcer en vba le renvoi à la ligne après fusion?

j'ai essayé de revoir mon code début pour l'alléger:

en gros je defini la ligne de départ par rapport au contenu antérieur

ligne = Start + Count_Partners + 3

j'ai besoin que pour chaque i cela fusionne la première ligne et la deuxième de la colonne A mais la meme chose sur la colonne B

c'est pourquoi j'écris

ligne1 = ligne + i '85 +1
ligne2 = ligne1 + 1 '86 + 1

mais je dois mal le coder.. en effet

For i = 1 To Count_wp
ligne = Start + Count_Partners + 3
If (i <= Count_wp) Then
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & ligne) = "Partners of the Consortium"
ligne1 = ligne + i '85 +1
ligne2 = ligne1 + 1 '86 + 1

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne1, 1), Cells(ligne2, 1)).Merge
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne1, 2), Cells(ligne2, 8)).Merge

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & ligne1) = "WP " & WP_Array.Cells(i, 2)

Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne + 1) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)
End If
Next

merci à vous en tout cas

Le 20/08/2020 à 16:24

Nickel,

Je ne sais pas ce que vous voulez mais essayez :

If ligne mod 2 = 0  then 'si ligne est paire
    .Range(Cells(ligne, 1), Cells(ligne + 1, 1)).Merge 'fusionne
    .Range(Cells(ligne, 2), Cells(ligne + 1, 8)).Merge
    .Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
    .Range("A" & ligne).WrapText = True
end if
Le 20/08/2020 à 16:34

merci mais voila ce que je souhaiterais mais semble assez compliqué à mettre en place

ligne = Start + Count_Partners + 3

j'ai besoin que pour chaque i cela fusionne la première ligne et la deuxième de la colonne A mais la meme chose sur la colonne B

c'est pourquoi j'écris (avec en exemple)

ligne1 = ligne + i '85 +1
ligne2 = ligne1 + 1 '86 + 1

mais je dois mal le coder.. en effet

Le 20/08/2020 à 16:49

Alors, je ne sais pas à quoi font référence Start et Count_Partners.

Il faut tant que possible éviter de rajouter trop de variables non nécessaires, à moins qu'elles permettent d'alléger la digestion du code.

Déjà, identifiez bien vos différents cas demandez vous ce que vous voulez vraiment renvoyer dans chacun de ces cas. N'hésitez pas à le poser sur papier plutôt que de l'inscrire en code directement.

Le 20/08/2020 à 16:51

Et je comprends pas bien ce que vous voulez fusionner. En tout cas, on ne peut fusionner qu'une intersection complète de lignes et de colonnes.

Le 20/08/2020 à 16:54
'compte le nombre de Work-Package à afficher
Count_wp = WP_Array.Rows.Count

'position de départ de ligne  de l'affichage des résultats 
' Count partner étant le nombr de partenaires afficher avant avec nombre de résultats variable
Start = Start + Count_Partners + 3

' l'inscrit le nom de la catégoroe
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & Start) = "Partners of the Consortium"

For i = 1 To Count_wp
ligne = Start + i

If (i <= Count_wp) Then

If ligne Mod 2 = 0 Then  'si ligne est paire
    Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne, 1), Cells(ligne + 1, 1)).Merge 'fusionne
    Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range(Cells(ligne, 2), Cells(ligne + 1, 8)).Merge
    Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
   ' Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("A" & ligne).WrapText = True
End If

'
'If (WP_Array.Cells(i, 9) = "Lead") Then
'Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne + 1).Font.Color = RGB(255, 0, 0)
'ElseIf (WP_Array.Cells(i, 9) = "Partner") Then
'Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne + 1).Font.Color = RGB(0, 0, 255)
'End If
Workbooks(Acronym & ".xlsm").Worksheets("Feuil1").Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)
End If
Next

seulement voila quand je teste cela tel quel cela s'affiche bien en fusion mais saute tout simpleebt les résulatats de i = 2 ou 4 6 8 10 12 14 et 16 etc.

Le 20/08/2020 à 17:40

Pour l'instant, je n'ai toujours pas bien compris à quoi correspondait Start et Count Partner.

Oui, en A & ligne, vous n'avez qu'une valeur sur 2 quand ligne est pair (i impair). Car en A, les cellules sont fusionnées par paires alors qu'elles ne le sont pas sur les autres colonnes. Sinon, votre valeur quand ligne est impair (i pair) effacerait votre valeur en ligne -1.

Si vous voulez les 2 valeurs en 1 seul cellule, il faut un peut réadapter. La logique :

If ligne mod 2 = 0  then 'si ligne est paire
    .Range(Cells(ligne, 1), Cells(ligne + 1, 1)).Merge 'fusionne
    .Range(Cells(ligne, 2), Cells(ligne + 1, 8)).Merge
    Attente = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée 'Attente stock la moitié du résultat
Else:
    .Range("A" & ligne) = Attente & Chr(10) & "WP " & WP_Array.Cells(i, 2) 'Quand ligne est impair, Aligne obtient sa valeur
    .Range("A" & ligne).WrapText = True
end if
Le 20/08/2020 à 18:42

Bonjour,

Tout d'abord merci pour votre assistance et désolé si je me suis mal exprimé sur mon objectif

Pour l'instant, je n'ai toujours pas bien compris à quoi correspondait Start et Count Partner.

Ceci n'est pas un problème.C'est juste pour savoir ou débuter l'affichage mais le soucis ne vient même pas de là de toute façon.

mais pour vous répondre:

Count_Partners = Partners_Array.Rows.Count

cela compte le nombre de partenaires à afficher

Start = "48"

dit à quelle ligne doit commencer l'affichage des partenaires

Ici ce que je souhaite afficher c'est

Colonne A Colonne B

WP1 Titre du WP1

WP2 Titre du WP2

etc.

seulement voila comme les titres sont parfois très long sur une seule ligne ça ne tient pas du coup je dois pouvoir les faire tenir sur 2 lignes et c'est pourquoi je tente de fusionner la ligne avec celle d'après en vue pouvoir générer un pdf qui ne coupe pas le texte

fusionner les lignes pour la colonne A n'est en soit pas obligatoire car là aucun soucis de longueur mais c'était plus pour l'esthétisme je dirais!

par contre pour la colonne B j'ai effectivement besoin de fusionner deux lignes de la colonne B à H

Aussi je ne sais meme plus bien si j'ai procédé correctement pour cela..

et je dois avouer que je cerne pas trop l'intéret des lignes paires et impaires..

Aussi merci de bien vouloir m'éclairer

Bonne soiree à vous et encore merci par avance

Le 20/08/2020 à 20:14

D'accord, alors, je pense commencer à comprendre ce que vous attendez. Cependant, sans fichier, rien n'est évident.

Il faut se dire que, par nature, les cellules fusionnées sont difficiles à travailler et qu'il vaut mieux les éviter tant que possible, sur excel déjà mais encore plus avec VBA.

J'ai une première proposition à vous faire : ne fusionner aucune des colonnes et ajuster la hauteur de la ligne aux contenus des cellules

With Workbooks(Acronym & ".xlsm").Worksheets("Feuil1")

For i = 1 To Count_wp

    ligne = 49 + i

    If i = 1 Then 'si i=1, mise en forme sous condition
        With .Range("B" & ligne)
            If WP_Array.Cells(i, 9) = "Lead" Then
                .Font.Color = RGB(255, 0, 0)
            ElseIf WP_Array.Cells(i, 9) = "Partner" Then
                .Font.Color = RGB(0, 0, 255)
            end if
        end with
    End If

    .Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
    .Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)

    With .Range("A" & ligne & ":H" & ligne)
        .WrapText = True
        .VerticalAlignment = xlVAlignCenter
    end with
    '.Rows(ligne).autofit 'a essayer éventuellement
Next i

end with
Le 20/08/2020 à 20:19

Une seconde proposition, plus simple et plus estéthique, mais moins adaptable aux éventuels changements : affecter à chaque ligne une hauteur

With Workbooks(Acronym & ".xlsm").Worksheets("Feuil1")

For i = 1 To Count_wp

    ligne = 49 + i

    If i = 1 Then 'si i=1, mise en forme sous condition
        With .Range("B" & ligne)
            If WP_Array.Cells(i, 9) = "Lead" Then
                .Font.Color = RGB(255, 0, 0)
            ElseIf WP_Array.Cells(i, 9) = "Partner" Then
                .Font.Color = RGB(0, 0, 255)
            end if
        end with
    End If

    .Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
    .Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)

    With .Rows(ligne)
        .RowHeight = 30
        .VerticalAlignment = xlVAlignCenter
    end with
Next i

end with
Le 20/08/2020 à 20:53

je vous remercie pour votre réactivité

j'ai testé le deuxième code que je trouvais être une bonne idée (je ne savais pas que vba pouvait jouer sur la hauteur des lignes)

cela fonctionne en terme d'affichage pour tous les résultats et la hauteur des lignes s'adapte mais cependant la ligne est toujours trop longue et du coup le texte est coupé lors de l'impression ou du pdf généré

il faudrait que cela tienne entre les colonnes B à H sans dépasser et si plus long retour à la ligne ce qui est problème initial

merci par avance

bonne soirée

Le 20/08/2020 à 21:12

Il y a peu de choses que VBA ne puisse pas faire. Je ne peux pas voir votre fichier donc je ne comprends pas les contraintes.

Essayez de jongler avec les solutions que je vous ai données :

.WrapText = True (renvoi)

.RowHeight = ?? (paramétrer hauteur de ligne)

.Autofit (ajustement hauteur de ligne)

Vous pouvez changer vous-même la hauteur avec .RowHeight. Moi j'ai mis 30 comme ça, mais vous pouvez mettre 31 ou 48, comme vous voulez.

Vous pouvez aussi tenter d'élargir les colonnes qui ont des contenus très longs pour atténuer la hauteur des lignes.

With Workbooks(Acronym & ".xlsm").Worksheets("Feuil1")

For i = 1 To Count_wp

    ligne = 49 + i

    If i = 1 Then 'si i=1, mise en forme sous condition
        With .Range("B" & ligne)
            If WP_Array.Cells(i, 9) = "Lead" Then
                .Font.Color = RGB(255, 0, 0)
            ElseIf WP_Array.Cells(i, 9) = "Partner" Then
                .Font.Color = RGB(0, 0, 255)
            end if
        end with
    End If

    .Range("A" & ligne) = "WP " & WP_Array.Cells(i, 2) 'Aligne mouvementée
    .Range("B" & ligne) = WP_Array.Cells(i, 3) & " (" & WP_Array.Cells(i, 4) & "PM) - " & WP_Array.Cells(i, 9)

    With .Rows(ligne)
        .RowHeight = 30 'à modifier
        .WrapText = True 'renvoi à la ligne
        .VerticalAlignment = xlVAlignCenter 'alignement vertical
    end with
Next i

end with

Peut-être qu'en essayant comme ça, ce sera bon.

En tout cas, je ne peux rien faire de plus que vous donner les outils pour faire vos personnalisations, surtout si je ne vois pas le fichier...

Cordialement,

Le 21/08/2020 à 08:52

Bonjour et merci pour vos retours

je vous prie de bien vouloir trouver ci-joint le document généré dont j'ai anonymisé le contenu.

le problème réside dans cet exemple à partir la ligne 86 où la liste des Work-packages est inséré

On voit bien que les titres sont trop longs et dépasserons de la zone d'impression et cest pourquoi je m'étais orienté vers la fusion de cellule.

je vais tenter toutefois l'élargissement de la colonne B comme indiqué

8acronym.xlsm (19.47 Ko)

Cordialement

Le 21/08/2020 à 11:56

Bonjour,

D'accord, j'avais pas bien compris le problème, que j'ai tout à fait saisi maintenant.

J'ai un début de solution à vous proposer (hauteur de ligne fixe quand B est remplie). Si ça vous convenait, ce serait super. Sinon, il faudrait changer de méthode et c'est assez compliqué (ajuster la hauteur de la ligne quand des cellules fusionnées ont un renvoi automatique), en tout cas pour moi.

'BOUT DE CODE A INSERER DANS TA MACRO PRINCIPALE (SANS REPRISE DES VALEURS)

Sub MiseEnPage()

For i = 1 To Count_wp

ligne = 49 + i

If Range("B" & ligne).Value = vide Then
    FormatLigneSiVide (ligne)
Else: FormatLigneTitres (iligne
End If

Next i

End Sub

'--------------------------------------------------------------------------------
'EXECUTE CETTE MACRO QUAND LES CELLULES EN B, A PARTIR DE LA LIGNE 50, SONT VIDES

Sub FormatLigneSiVide(NumLigne As Integer) 's'exécute au numéro de ligne renseigné

With ActiveSheet

    With .Range("B" & NumLigne & ":H" & NumLigne) 'pour les cellules B-H
        .MergeCells = False 'défusionne
        .WrapText = False 'enlève renvoi
        .HorizontalAlignment = xlJustify 'alignt horiz justifié
    End With

End With

End Sub

'--------------------------------------------------------------------------------
'EXECUTE CETTE MACRO QUAND LES CELLULES EN B, A PARTIR DE LA LIGNE 50, SONT REMPLIES

Sub FormatLigneTitres(NumLigne As Integer) 's'exécute au numéro de ligne renseigné

With ActiveSheet

    With .Range("B" & NumLigne & ":H" & NumLigne) 'cell B-H
        .MergeCells = True 'cellules fusionnées
        .WrapText = True 'renvoi auto à la ligne
        .HorizontalAlignment = xlJustify 'alignt justifié
    End With

    With Rows(NumLigne)
        .RowHeight = 28 'hauteur des lignes définie à 28
        .VerticalAlignment = xlTop 'alignt vertical en haut
    End With

End With

End Sub

L'idéal serait tout de même, si les colonnes C à H n'accueillaient pas de valeurs, d'élargir la colonne B sans fusionner de cellules. Ce serait beaucoup plus simple, sans erreur et plus rapide à exécuter...

Le 21/08/2020 à 12:03

Bonjour,

merci pour ce nouveau code que je vais tenté

néanmoins et selon vos recommendations j'ai bien élargi la colonne B et restructuré et cela fonctionne effectivement sans fusion à prévoir

encore merci pour tout

Le 21/08/2020 à 12:28

Très bien, super, Content que ça vous convienne !

J'ai déjà rencontré un problème similaire par le passé et même quand on y trouve une solution, elle n'est jamais satisfaisante...

Conclusion, les fusions, je les évite tant que possible.

Bonne journée,

Rechercher des sujets similaires à "probleme fusion vba"