renvoyer à la ligne automatiquement

Le
Christian de BXL
Bonjour à tous,
Je cherche à solutionner un problème de renvoi à la ligne automatique dans
des cellules fusionnées.
Dans un post de 2005 une réponse de Gaenonius renvoyait à la réponse suivante:

Attribute VB_Name = "AjusterHauteurLignesMergedCells"


'ajuster automatiquement la hauteur de ligne de cellules fusionnées
'la macro est conçue pour agir sur des cellules fusionnées sur la
'même ligne (ou à l'aide du bouton "centrer sur plusieurs colonnes")

Sub AutoFitMergedCellRowHeight()
'Jim Rech, mpep

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If

End Sub

publiée par Frederic Sigonneau.
J'ai retranscrit ces instructions dans un module, cela fonctionne quand je
l'active manuellement sur la cellule voulue, mais pas automatiquement.
Un module est-il un bon endroit pour recopier cette instruction ou y a-t-il
une subtilité que je n'aurait pas saisi.

Merci de vos conseils
Vidéos High-Tech et Jeu Vidéo
Téléchargements
Vos réponses
Gagnez chaque mois un abonnement Premium avec GNT : Inscrivez-vous !
Trier par : date / pertinence
Daniel
Le #4802231
Bonsoir.
Clic droit sur l'onglet de la feuille; clic sur visualiser le code; colle :

Private Sub Worksheet_Change(ByVal Target As Range)
'Jim Rech, mpep

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim targetWidth As Single, PossNewRowHeight As Single

If Target.MergeCells Then
With Target.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif
fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
targetWidth = Target.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = targetWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If

End Sub

Tu peux limiter le champde la macro à la plage voulue, car telle quelle, la
macro va s'exécuter à chaque fois que tu vas entrer quelque chose dans une
cellule de la feuille.
Si tu ne sais pas coment faire pour limiter la plage, reviens le dire.
Cordialement.
Daniel
"Christian de BXL" le message de news:
Bonjour à tous,
Je cherche à solutionner un problème de renvoi à la ligne automatique dans
des cellules fusionnées.
Dans un post de 2005 une réponse de Gaenonius renvoyait à la réponse
suivante:

Attribute VB_Name = "AjusterHauteurLignesMergedCells"


'ajuster automatiquement la hauteur de ligne de cellules fusionnées
'la macro est conçue pour agir sur des cellules fusionnées sur la
'même ligne (ou à l'aide du bouton "centrer sur plusieurs colonnes")

Sub AutoFitMergedCellRowHeight()
'Jim Rech, mpep

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique (modif
fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If

End Sub

publiée par Frederic Sigonneau.
J'ai retranscrit ces instructions dans un module, cela fonctionne quand je
l'active manuellement sur la cellule voulue, mais pas automatiquement.
Un module est-il un bon endroit pour recopier cette instruction ou y
a-t-il
une subtilité que je n'aurait pas saisi.

Merci de vos conseils


vivienm Hors ligne
Le #26325737
Le lundi 20 Août 2007 à 17:24 par Christian de BXL :
Bonjour à tous,
Je cherche à solutionner un problème de renvoi à la ligne
automatique dans
des cellules fusionnées.
Dans un post de 2005 une réponse de Gaenonius renvoyait à la
réponse suivante:

Attribute VB_Name = "AjusterHauteurLignesMergedCells"


'ajuster automatiquement la hauteur de ligne de cellules fusionnées
'la macro est conçue pour agir sur des cellules fusionnées sur
la
'même ligne (ou à l'aide du bouton "centrer sur plusieurs
colonnes")

Sub AutoFitMergedCellRowHeight()
'Jim Rech, mpep

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
.WrapText = True 'enclenche le renvoi à la ligne automatique
(modif fs)
If .Rows.Count = 1 Then 'And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If

End Sub

publiée par Frederic Sigonneau.
J'ai retranscrit ces instructions dans un module, cela fonctionne quand je
l'active manuellement sur la cellule voulue, mais pas automatiquement.
Un module est-il un bon endroit pour recopier cette instruction ou y a-t-il
une subtilité que je n'aurait pas saisi.

Merci de vos conseils


Bonjour,

J'ai besoin d'aide pour appliquer complètement cette formule à mon fichier.

1) Attention les lettre "fs)" qui sont en retour à la ligne fausse le code

2) Le code fonctionne et redimensionne bien les lignes en fonction du contenu obtenu par mes menu déroulant, cependant :

- si j'efface le contenu d'une cellule fusionné, une erreur d'exécution '1004' : Erreur définie par l'application ou par l'objet. Lorsque j'appuie sur Débogage, la partie "With Target.MergeArea" est surligné en jaune.

- la ligne garde la grosse taille ajustée même si tous le contenu est supprimé

Sauriez vous trouver le problème ?

En vous remerciant,

Vivien
Publicité
Poster une réponse
Anonyme