FORUM Tom's Hardware » Programmation » VB / VBA / VBS » Macro "renvoi à la ligne automatique"
 

Macro "renvoi à la ligne automatique"

Il y a 324 utilisateurs connus et inconnus. Pour voir la liste des connectés connus, cliquez ici
Ajouter une réponse



 Mot :   Pseudo :  
 
Bas de page
Auteur
 Sujet : Macro "renvoi à la ligne automatique"
 
NanieCouet te
Plus d'informations
n°35990
17-10-2007 à 11:24:52

Bonjour,
 
Je souhaiterais faire une macro renvoi à la ligne automatique cellules fusionnées.
 
En surfant sur le net, j'ai trouvé cette macro qui marche mais je ne comprend pas tout et ne sais pas comment lui dire de le faire automatiquement sur une feuille complète :  
 

Code :
  1. Sub AutoFitMergedCellRowHeight()
  3. Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
  4. Dim CurrCell As Range
  5. Dim ActiveCellWidth As Single, PossNewRowHeight As Single
  7. If ActiveCell.MergeCells Then
  8.    With ActiveCell.MergeArea
  9.      .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
  10.      If .Rows.Count = 1 Then 'And .WrapText = True Then
  11.        Application.ScreenUpdating = False
  12.        CurrentRowHeight = .RowHeight
  13.        ActiveCellWidth = ActiveCell.ColumnWidth
  14.        For Each CurrCell In Selection
  15.            MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
  16.        Next
  17.       .MergeCells = False
  18.       .Cells(1).ColumnWidth = MergedCellRgWidth
  19.       .EntireRow.AutoFit
  20.        PossNewRowHeight = .RowHeight
  21.       .Cells(1).ColumnWidth = ActiveCellWidth
  22.       .MergeCells = True
  23.       .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
  24.      End If
  25.    End With
  26. End If
  28. End Sub


 
En fait, mon idée est de faire une macro qui dit : tu me cherches toutes les cellules fusionnées sur une feuille nommée XXX, et tu me fais le renvoi à la ligne automatique pour toutes, ce qui se caratérise au final par la ligne qui se dimensionne correctement pour pouvoir voir tout mon texte.
 
Une idée en partant de ce code qui marche ?  :whistle:  
 
Merci pour votre aide précieuse.
 
 :bounce:

NanieCouet te
Plus d'informations
n°35991
17-10-2007 à 11:25:18

Code qui marche mais me laisse un gros espace blanc AVANT et APRES mon texte donc à revoir :
 

Code :
  1. Sub AutoFitMergedCellRowHeight()
  3. Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
  4. Dim CurrCell As Range, Cel As Range
  5. Dim ActiveCellWidth As Single, PossNewRowHeight As Single
  6. For Each Cel In ActiveSheet.UsedRange ' <--- Zone à déterminer
  7. On Error Resume Next ' <-----Ici
  8. If Cel.MergeCells And Not Cel.Offset(0, -1).MergeCells Then ' <-----Ici
  9. On Error GoTo 0 ' <-----Ici
  10. Cel.Select
  11. MergedCellRgWidth = 0: PossNewRowHeight = 0
  12. With ActiveCell.MergeArea
  13. .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
  14. If .Rows.Count = 1 Then 'And .WrapText = True Then
  15. Application.ScreenUpdating = False
  16. CurrentRowHeight = .RowHeight
  17. ActiveCellWidth = ActiveCell.ColumnWidth
  18. For Each CurrCell In Selection
  19. MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
  20. Next
  21. .MergeCells = False
  22. .Cells(Cel.Row, Cel.Column).ColumnWidth = MergedCellRgWidth
  23. .VerticalAlignment = xlCenter
  24. .EntireRow.AutoFit
  25. PossNewRowHeight = .RowHeight
  26. .Cells(Cel.Row, Cel.Column).ColumnWidth = ActiveCellWidth
  27. .MergeCells = True
  28. .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, CurrentRowHeight, PossNewRowHeight)
  29. End If
  30. End With
  31. End If
  32. Next Cel
  33. End Sub
zeb
Profil : Modérateur libre
Plus d'informations
n°35994
17-10-2007 à 11:39:00

Citation :

Une idée en partant de ce code qui marche ?  :whistle:


Mauvaise idée.
 

Citation :

En fait, mon idée est de faire une macro qui dit : tu me cherches toutes les cellules fusionnées sur une feuille nommée XXX, et tu me fais le renvoi à la ligne automatique pour toutes, ce qui se caratérise au final par la ligne qui se dimensionne correctement pour pouvoir voir tout mon texte.

Très bonne idée. C'est parti.
 
Découpons ce gros problème en petits problèmes simples :
 

  • Comment désigner la feuille XXX ?
  • Comment désigner toutes les cellules d'une feuille ?
  • Comment parcourir les cellules d'une plage de cellules ?
  • Comment déterminer si une cellule est fusionnée avec une autre ou pas ?
  • Comment établir le renvoi automatique à la ligne pour une cellule ?


J'ai l'intention de t'aider, mais pas de te le faire. C'est comme ça. [:spamafote]
Réponds donc à ces questions si tu peux.
 
Ensuite, on montera ça comme des LEGOs(R). :)


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
NanieCouet te
Plus d'informations
n°35995
17-10-2007 à 11:57:54

Citation :

Comment désigner la feuille XXX ?

 
Sheets("XXX" ).Select
 

Citation :

Comment désigner toutes les cellules d'une feuille ?

 
 :heink:  :(  
 

Citation :

Comment parcourir les cellules d'une plage de cellules ?


For Each Cel In SelectSheets.UsedRange  :whistle:  
 

Citation :

Comment déterminer si une cellule est fusionnée avec une autre ou pas ?


If XXX.Range(XXX.Cells(Cell.Row, Cell.Column), XXX.Cells(Cell.Row, Cell.Column + ?)).MergeCells
 

Citation :

Comment établir le renvoi automatique à la ligne pour une cellule ?


Un truc du genre : .WrapText = True  :sarcastic:  
 
 
 
Ah mon avis j'ai des fautes ...  :pt1cable:  
 
Je résume le style de fichier que j'ai :
 
- cellules fusionnées pouvant avoir plus de 2 cellules fusionnées entre elles
- cellules fusionnées pouvant se trouver dans n'importe quelle colonne de la feuille (donc pas forcément en colonne A)
- possibilité de plusieurs zones de cellules fusionnées sur une même ligne mais pas forcément côte à côte

zeb
Profil : Modérateur libre
Plus d'informations
n°35998
17-10-2007 à 14:45:26

Q: Comment désigner la feuille XXX ?
R: Sheets("XXX" ).Select
2/4
 
Oui et Non.  
Sheets("XXX" ) tout court !!
Select sélectionne la feuille, ce dont nous n'aurons pas besoin.
Mais puisqu'il s'agit d'une feuille de calcul, autant utiliser WorkSheets("XXX" )
 
Q: Comment désigner toutes les cellules d'une feuille ?
R: ....
0/4
 
C'est pourtant si facile :
WorkSheets("XXX" ).Cells
 
Q: Comment parcourir les cellules d'une plage de cellules ?
R: For Each Cel In SelectSheets.UsedRange
4/4
Tu en fais trop !! Je n'ai demandé qu'une plage.
Disons que l'exemple n'est qu'un exemple.
 
Q: Comment déterminer si une cellule est fusionnée avec une autre ou pas ?
R: If XXX.Range(XXX.Cells(Cell.Row, Cell.Column), XXX.Cells(Cell.Row, Cell.Column + ?)).MergeCells  
3,5/4
Tu en fait encore trop !! cel.MergeCells suffit.
 
Q: Comment établir le renvoi automatique à la ligne pour une cellule ?
R: Un truc du genre : .WrapText = True
4/4
Très bonne réponse.
 
 
13,5/20. Peut mieux faire :o
 
 
Allez on mélange tout :
 

Citation :

Pour chaque cellule de toutes les cellules de la feuille XXX, si cette cellule est fusionnée, mettre sa propriété WrapText à vrai :


Code :
  1. Dim cel As Range
  2. For Each cel In WorkSheets("XXX" ).Cells
  3.     If cel.MergeCells Then cel.WrapText = True
  4. Next


 
C'est tout.
D'où l'idée de ne pas partir du bazar proposé au début.
 

Spoiler :

(Je ne sais pas pourquoi, je sens venir les plaintes et les jérémiades à propos d'Excel)

Message cité 1 fois

---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
NanieCouet te
Plus d'informations
n°36003
17-10-2007 à 16:04:20

Je suis en train de tester mais en fait je veux bien partir sur l'idée de la plage nommée (qui ferait par exemple A1 à Z100) car là ça prend toute ma feuille cellule par cellule et ça fait 5mn que ça réfléchi ...  :pt1cable:  :D  :whistle:  
 
Est-ce que un code fait ainsi est bon monsieur le professeur :
 

Code :
  1. Dim cel As Range
  2. For Each cel In Range("PLAGENOMMEE" ).Cells
  3. If cel.MergeCells Then cel.WrapText = True
  4. Next


 
En tout cas merci de me faire participer car c'est ainsi qu'on apprend !!!
 
 :bounce:

NanieCouet te
Plus d'informations
n°36004
17-10-2007 à 16:24:34

Résultat : ça n'a rien fait ...  :cry:

zeb
Profil : Modérateur libre
Plus d'informations
n°36006
17-10-2007 à 17:14:57

A tester :

Code :
  1. Dim c As Range
  3. Sub toto()
  4.     MsgBox "La plage à parcourir est la suivante : " & _
  5.            Range("PLAGENOMMEE" ).Address(0, 0)
  6.  
  7.     For Each c In Range("PLAGENOMMEE" )
  8.         If c.MergeCells Then
  9.             MsgBox "Je suis la cellule " & c.Address(0, 0) & " et je suis fusionnée."
  10.             c.WrapText = True
  11.         End If
  12.     Next
  13. End Sub


 
Si tu sais ce qu'est la fenêtre d'exécution sous l'éditeur VB ([CTRL+G]), tu peux remplacer MsgBox par Debug.Print. C'est plus cool.
 
Tips: [CTRL+Pause] pour ^mettre une macro sur Pause ;)


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
NanieCouet te
Plus d'informations
n°36009
17-10-2007 à 17:50:44

Non je ne sais pas à quoi sert la fenêtre d'exécution ...  :sweat:  
 
Sinon, le code n'a rien fait de particulier sur mon fichier essai ... et avoir une fenêtre à valider cellule par cellule, on n'est pas rendu car j'ai un fichier réel bourré de cellules fusionnées à mettre à jour ...  :pt1cable:

zeb
Profil : Modérateur libre
Plus d'informations
n°36010
17-10-2007 à 17:59:06

C'est pourquoi je t'en parle !!!!!
 
Dans l'éditeur de VB, tu cherches "fenêtre d'exécution", et tu testes CTRL+G et CTRL+Pause...
 
Comme je ne peux pas le faire à ta place, je te donnes toutes les billes pour que tu puisses débugger ton bazar toute seule.


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
NanieCouet te
Plus d'informations
n°36012
17-10-2007 à 18:10:14

Tu me parles chinois car je fais CTRL+G mais rien se passe ...  :whistle:  
 
Question bête mais puisque la macro n'a rien fait, je voulais m'assurer que tu savais que le renvoi à la ligne automatique du menu excel ne marche pas sur les cellules fusionnées, des fois que la macro passe par cette fonction ... d'où le problème à créer.
 
 :D  :pt1cable:  :D

Message cité 1 fois
zeb
Profil : Modérateur libre
Plus d'informations
n°36018
18-10-2007 à 10:57:42

zeb a écrit :

[b]

Spoiler :

(Je ne sais pas pourquoi, je sens venir les plaintes et les jérémiades à propos d'Excel)



NanieCouette a écrit :

Question bête mais puisque la macro n'a rien fait, je voulais m'assurer que tu savais que le renvoi à la ligne automatique du menu excel ne marche pas sur les cellules fusionnées, des fois que la macro passe par cette fonction ... d'où le problème à créer.
 
 :D  :pt1cable:  :D


 
:sol: Comment ça je ne sais pas ? Clique sur spoiler pour voir.
Le renvoi à la ligne fonctionne même sur les cellules fusionnées, par contre, la hauteur de la ligne ne prend pas automatiquement la taille du texte qui y est renvoyé à la ligne. [:spamafote]
 
Voila, maintenant tu peux te plaindre et faire des jérémiades :(


---------------
Règlement du forum / Règlement de Programmation / Règlement du Monde de Linux euh, n'y en a pas...
NanieCouet te
Plus d'informations
n°36020
18-10-2007 à 11:16:11

SOLUTION :
 

Code :
  1. Sub Trouvercellfusionnées()
  2. Dim cell As Range
  3.   With ActiveSheet.UsedRange
  4.     For Each cell In .Cells
  5.       With cell
  6.           If .MergeCells = True Then
  7.           .Activate
  8.           .RowHeight = 12.75
  9.           Call AutoFitMergedCellRowHeight
  10.           End If
  11.       End With
  12.     Next cell
  13.   End With
  14. End Sub

 
 
Avec cette deuxième macro :
 

Code :
  1. Sub AutoFitMergedCellRowHeight()
  2. 'MAcro de Jim Rech
  3. Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
  4. Dim CurrCell As Range
  5. Dim ActiveCellWidth As Single, PossNewRowHeight As Single
  6.   If ActiveCell.MergeCells Then
  7.     With ActiveCell.MergeArea
  8.       .WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
  9.       If .Rows.Count = 1 Then 'And .WrapText = True Then
  10.         Application.ScreenUpdating = False
  11.         CurrentRowHeight = .RowHeight
  12.         ActiveCellWidth = ActiveCell.ColumnWidth
  13.         For Each CurrCell In Selection
  14.           MergedCellRgWidth = CurrCell.ColumnWidth + _
  15.             MergedCellRgWidth
  16.         Next
  17.        .MergeCells = False
  18.        .Cells(1).ColumnWidth = MergedCellRgWidth
  19.        .EntireRow.AutoFit
  20.         PossNewRowHeight = .RowHeight
  21.        .Cells(1).ColumnWidth = ActiveCellWidth
  22.        .MergeCells = True
  23.        .RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
  24.          CurrentRowHeight, PossNewRowHeight)
  25.       End If
  26.     End With
  27.   End If
  28. End Sub

 
 
Toujours démarrer sur la macro Trouvercellfusionnées.  
Les deux macros sont à placer dans un module.  
 
 :bounce:  
 
 
 
Dans l'attente de tes remarques ...  :whistle:


Aller à :
Ajouter une réponse
  FORUM Tom's Hardware » Programmation » VB / VBA / VBS » Macro "renvoi à la ligne automatique"
 

Plan du forum
Forum MesDiscussions.Net, Version 2007.1.2
© 2000-2007 No1Dev
Page générée en 0.238 secondes
Annonces Google
Produits relatifs
Publicité
Sujets relatifs
voir tout
Actualités relatives
Les dernières actualités
voir tout
Les derniers tests
voir tout
Dans les albums
Les ressources relatives
Les téléchargements