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:
'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.
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel
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" a écrit dans 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:
'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
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" <ChristiandeBXL@discussions.microsoft.com> a écrit dans
le message de news: 6EFECCB2-1653-45C4-9A47-A767A06964AE@microsoft.com...
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:
'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.
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" a écrit dans 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:
'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
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:
'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
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:
'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é
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:
'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é
