Taille de celulle

Daniel,
ça fonctionne vraiment très très bien.
Encore un petit truc
Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la ligne
auto, qui sont en fait des reprises de celulles d'autres pages, des celulles
du même type, c'est à dire fusionnée avec remise auto à la ligne.
par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62 se
mette à jour de ce que j'ai saisi en feuille "20", B44.

je pensais à F9, uniquement pour la feuille "GA01", mais ça ne marche pas.

Merci.


"Daniel.C" a écrit :

Dans "thisworkbook", mets :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For i = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next i
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
Application.EnableEvents = True
End Sub

Cordialement.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
> Impecable, ça focntionne.
> Désolé pour la question d'avant, il suffit de saisir un truc dans la
> celulle, nickel crome !!!!
>
> Et, on peut lui demander vite pour que ça fonctionne pour une page
> entière,
> voir le classeur entier, seulement pour les celulles qui sont en "renvoyer
> à
> la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>
> MERCI..
>
> ....
> Par contre, le 16/09, j'avais mis un post pour un problème d'impression.
> Ta
> réponse et celle d'un autre du forum m'aide, mais ne fonctionne pas, car
> le
> fait que NA soit saisi ou pas dans la celule A4,il imprime la feuille
> quand
> même.
> Donc si tu as une autre idée pour moi, merci d'avance.
> YANN
>
>
>
> "Daniel.C" a écrit :
>
>> Mets le code suivant dans le module de ta feuille :
>>
>> Private Sub Worksheet_Change(ByVal Target As Range)
>> Dim c As Range, Largeur As Double, Hauteur As Single
>> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit Sub
>> Application.EnableEvents = False
>> Largeur = 10.71 * 8
>> Hauteur = 15
>> With ActiveSheet.UsedRange
>> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1,
>> 1)
>> c.ColumnWidth = Largeur
>> c.WrapText = True
>> c.Value = Target.Value
>> Rows(22).RowHeight = c.Height
>> End With
>> Application.EnableEvents = True
>> End Sub
>>
>> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage A22:H22.
>> --
>> Cordialement.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
>> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> > Re,
>> > pour compléter, ça marche avec une celulle (j'avais oublié le "Format /
>> > lignes / ajustement automatique"), mais ça marche pas avec une ligne de
>> > celulles fusionnées.
>> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et je veux
>> > que
>> > ce
>> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >
>> > Est ce possible, en VBA ou pas.
>> > MERCI.
>> >
>> > Yann
>>
>>
>>

Le seul moyen de s'en sortir est de recalculer la taille de toutes ces
cellules à chaque recalcul, ce qui implique de les rechercher en balayant
l'ensemble du classeur, ce qui va ralentir considérablement tout recalcul, à
moins que tu aies peu de cellules concernées.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 007FD70D-5979-47EA-8791-F66588A1CCED@microsoft.com...

Daniel,
ça fonctionne vraiment très très bien.
Encore un petit truc
Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la ligne
auto, qui sont en fait des reprises de celulles d'autres pages, des
celulles
du même type, c'est à dire fusionnée avec remise auto à la ligne.
par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62 se
mette à jour de ce que j'ai saisi en feuille "20", B44.

je pensais à F9, uniquement pour la feuille "GA01", mais ça ne marche pas.

Merci.


"Daniel.C" a écrit :

Dans "thisworkbook", mets :

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For i = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next i
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1,
1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
Application.EnableEvents = True
End Sub

Cordialement.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
> Impecable, ça focntionne.
> Désolé pour la question d'avant, il suffit de saisir un truc dans la
> celulle, nickel crome !!!!
>
> Et, on peut lui demander vite pour que ça fonctionne pour une page
> entière,
> voir le classeur entier, seulement pour les celulles qui sont en
> "renvoyer
> à
> la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>
> MERCI..
>
> ....
> Par contre, le 16/09, j'avais mis un post pour un problème
> d'impression.
> Ta
> réponse et celle d'un autre du forum m'aide, mais ne fonctionne pas,
> car
> le
> fait que NA soit saisi ou pas dans la celule A4,il imprime la feuille
> quand
> même.
> Donc si tu as une autre idée pour moi, merci d'avance.
> YANN
>
>
>
> "Daniel.C" a écrit :
>
>> Mets le code suivant dans le module de ta feuille :
>>
>> Private Sub Worksheet_Change(ByVal Target As Range)
>> Dim c As Range, Largeur As Double, Hauteur As Single
>> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit Sub
>> Application.EnableEvents = False
>> Largeur = 10.71 * 8
>> Hauteur = 15
>> With ActiveSheet.UsedRange
>> Set c = Range(.Cells(.Rows.Count,
>> .Columns.Count).Address).Offset(1,
>> 1)
>> c.ColumnWidth = Largeur
>> c.WrapText = True
>> c.Value = Target.Value
>> Rows(22).RowHeight = c.Height
>> End With
>> Application.EnableEvents = True
>> End Sub
>>
>> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage
>> A22:H22.
>> --
>> Cordialement.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message
>> de
>> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> > Re,
>> > pour compléter, ça marche avec une celulle (j'avais oublié le
>> > "Format /
>> > lignes / ajustement automatique"), mais ça marche pas avec une ligne
>> > de
>> > celulles fusionnées.
>> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et je veux
>> > que
>> > ce
>> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >
>> > Est ce possible, en VBA ou pas.
>> > MERCI.
>> >
>> > Yann
>>
>>
>>

Ah oui, je vois.
J'ai 40 cellules (fusionnées bien sûr, de la colonne B à L), qui s'étalent
de la ligne 52 à 109).
Ben sinon, si c'est pas possible, je vais voir pour faire autrement, j'ai de
la réflexion dans l'air si c'est le cas, lol .....

Merci
YANN

"Daniel.C" a écrit :

Le seul moyen de s'en sortir est de recalculer la taille de toutes ces
cellules à chaque recalcul, ce qui implique de les rechercher en balayant
l'ensemble du classeur, ce qui va ralentir considérablement tout recalcul, à
moins que tu aies peu de cellules concernées.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 007FD70D-5979-47EA-8791-F66588A1CCED@microsoft.com...
> Daniel,
> ça fonctionne vraiment très très bien.
> Encore un petit truc
> Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la ligne
> auto, qui sont en fait des reprises de celulles d'autres pages, des
> celulles
> du même type, c'est à dire fusionnée avec remise auto à la ligne.
> par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62 se
> mette à jour de ce que j'ai saisi en feuille "20", B44.
>
> je pensais à F9, uniquement pour la feuille "GA01", mais ça ne marche pas.
>
> Merci.
>
>
> "Daniel.C" a écrit :
>
>> Dans "thisworkbook", mets :
>>
>> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
>> Range)
>> Dim c As Range, Largeur As Double, Hauteur As Single
>> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
>> For i = 1 To Target.MergeArea.Columns.Count
>> Largeur = Largeur + Target.ColumnWidth
>> Next i
>> Application.EnableEvents = False
>> With ActiveSheet.UsedRange
>> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1,
>> 1)
>> c.ColumnWidth = Largeur
>> c.WrapText = True
>> c.Value = Target.Value
>> Target.EntireRow.RowHeight = c.Height
>> c.Clear
>> End With
>> Application.EnableEvents = True
>> End Sub
>>
>> Cordialement.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
>> news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
>> > Impecable, ça focntionne.
>> > Désolé pour la question d'avant, il suffit de saisir un truc dans la
>> > celulle, nickel crome !!!!
>> >
>> > Et, on peut lui demander vite pour que ça fonctionne pour une page
>> > entière,
>> > voir le classeur entier, seulement pour les celulles qui sont en
>> > "renvoyer
>> > à
>> > la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>> >
>> > MERCI..
>> >
>> > ....
>> > Par contre, le 16/09, j'avais mis un post pour un problème
>> > d'impression.
>> > Ta
>> > réponse et celle d'un autre du forum m'aide, mais ne fonctionne pas,
>> > car
>> > le
>> > fait que NA soit saisi ou pas dans la celule A4,il imprime la feuille
>> > quand
>> > même.
>> > Donc si tu as une autre idée pour moi, merci d'avance.
>> > YANN
>> >
>> >
>> >
>> > "Daniel.C" a écrit :
>> >
>> >> Mets le code suivant dans le module de ta feuille :
>> >>
>> >> Private Sub Worksheet_Change(ByVal Target As Range)
>> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit Sub
>> >> Application.EnableEvents = False
>> >> Largeur = 10.71 * 8
>> >> Hauteur = 15
>> >> With ActiveSheet.UsedRange
>> >> Set c = Range(.Cells(.Rows.Count,
>> >> .Columns.Count).Address).Offset(1,
>> >> 1)
>> >> c.ColumnWidth = Largeur
>> >> c.WrapText = True
>> >> c.Value = Target.Value
>> >> Rows(22).RowHeight = c.Height
>> >> End With
>> >> Application.EnableEvents = True
>> >> End Sub
>> >>
>> >> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage
>> >> A22:H22.
>> >> --
>> >> Cordialement.
>> >> Daniel
>> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message
>> >> de
>> >> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> >> > Re,
>> >> > pour compléter, ça marche avec une celulle (j'avais oublié le
>> >> > "Format /
>> >> > lignes / ajustement automatique"), mais ça marche pas avec une ligne
>> >> > de
>> >> > celulles fusionnées.
>> >> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et je veux
>> >> > que
>> >> > ce
>> >> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >> >
>> >> > Est ce possible, en VBA ou pas.
>> >> > MERCI.
>> >> >
>> >> > Yann
>> >>
>> >>
>> >>
>>
>>
>>

40, ce n'est pas rédhibitoire. Dans Thisworkbook, mets :

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For i = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next i
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
Recalcul
Application.EnableEvents = True
End Sub

Dans un mmodule, mets :

Sub Recalcul()
Dim c As Range, Largeur As Double, Hauteur As Single
Dim Cel As Range, sh As Worksheet, ResAdr As String
For Each sh In Sheets
With Application.FindFormat
.WrapText = True
.MergeCells = True
End With
Set Cel = sh.Cells.Find("*", SearchFormat:=True)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Var = Cel.Address
r = sh.Name
If Cel.HasFormula = True Then
For i = 1 To Cel.MergeArea.Columns.Count
Largeur = Largeur + Cel.ColumnWidth
Next i
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count,
.Columns.Count).Address).Offset(1)
Var = c.Address
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Cel.Value
Cel.EntireRow.RowHeight = c.Height
c.Clear
End With
End If
Set Cel = sh.Cells.Find("*", after:Îl, SearchFormat:=True)
'Set Cel = Cells.FindNext(Cel)
Loop While Cel.Address <> ResAdr
End If
Next sh
End Sub

Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 303D2719-E2FE-48EE-9778-75C743B40759@microsoft.com...

Ah oui, je vois.
J'ai 40 cellules (fusionnées bien sûr, de la colonne B à L), qui s'étalent
de la ligne 52 à 109).
Ben sinon, si c'est pas possible, je vais voir pour faire autrement, j'ai
de
la réflexion dans l'air si c'est le cas, lol .....

Merci
YANN

"Daniel.C" a écrit :

Le seul moyen de s'en sortir est de recalculer la taille de toutes ces
cellules à chaque recalcul, ce qui implique de les rechercher en balayant
l'ensemble du classeur, ce qui va ralentir considérablement tout
recalcul, à
moins que tu aies peu de cellules concernées.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 007FD70D-5979-47EA-8791-F66588A1CCED@microsoft.com...
> Daniel,
> ça fonctionne vraiment très très bien.
> Encore un petit truc
> Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la
> ligne
> auto, qui sont en fait des reprises de celulles d'autres pages, des
> celulles
> du même type, c'est à dire fusionnée avec remise auto à la ligne.
> par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62 se
> mette à jour de ce que j'ai saisi en feuille "20", B44.
>
> je pensais à F9, uniquement pour la feuille "GA01", mais ça ne marche
> pas.
>
> Merci.
>
>
> "Daniel.C" a écrit :
>
>> Dans "thisworkbook", mets :
>>
>> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
>> Range)
>> Dim c As Range, Largeur As Double, Hauteur As Single
>> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
>> For i = 1 To Target.MergeArea.Columns.Count
>> Largeur = Largeur + Target.ColumnWidth
>> Next i
>> Application.EnableEvents = False
>> With ActiveSheet.UsedRange
>> Set c = Range(.Cells(.Rows.Count,
>> .Columns.Count).Address).Offset(1,
>> 1)
>> c.ColumnWidth = Largeur
>> c.WrapText = True
>> c.Value = Target.Value
>> Target.EntireRow.RowHeight = c.Height
>> c.Clear
>> End With
>> Application.EnableEvents = True
>> End Sub
>>
>> Cordialement.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message
>> de
>> news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
>> > Impecable, ça focntionne.
>> > Désolé pour la question d'avant, il suffit de saisir un truc dans la
>> > celulle, nickel crome !!!!
>> >
>> > Et, on peut lui demander vite pour que ça fonctionne pour une page
>> > entière,
>> > voir le classeur entier, seulement pour les celulles qui sont en
>> > "renvoyer
>> > à
>> > la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>> >
>> > MERCI..
>> >
>> > ....
>> > Par contre, le 16/09, j'avais mis un post pour un problème
>> > d'impression.
>> > Ta
>> > réponse et celle d'un autre du forum m'aide, mais ne fonctionne pas,
>> > car
>> > le
>> > fait que NA soit saisi ou pas dans la celule A4,il imprime la
>> > feuille
>> > quand
>> > même.
>> > Donc si tu as une autre idée pour moi, merci d'avance.
>> > YANN
>> >
>> >
>> >
>> > "Daniel.C" a écrit :
>> >
>> >> Mets le code suivant dans le module de ta feuille :
>> >>
>> >> Private Sub Worksheet_Change(ByVal Target As Range)
>> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit Sub
>> >> Application.EnableEvents = False
>> >> Largeur = 10.71 * 8
>> >> Hauteur = 15
>> >> With ActiveSheet.UsedRange
>> >> Set c = Range(.Cells(.Rows.Count,
>> >> .Columns.Count).Address).Offset(1,
>> >> 1)
>> >> c.ColumnWidth = Largeur
>> >> c.WrapText = True
>> >> c.Value = Target.Value
>> >> Rows(22).RowHeight = c.Height
>> >> End With
>> >> Application.EnableEvents = True
>> >> End Sub
>> >>
>> >> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage
>> >> A22:H22.
>> >> --
>> >> Cordialement.
>> >> Daniel
>> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le
>> >> message
>> >> de
>> >> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> >> > Re,
>> >> > pour compléter, ça marche avec une celulle (j'avais oublié le
>> >> > "Format /
>> >> > lignes / ajustement automatique"), mais ça marche pas avec une
>> >> > ligne
>> >> > de
>> >> > celulles fusionnées.
>> >> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et je
>> >> > veux
>> >> > que
>> >> > ce
>> >> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >> >
>> >> > Est ce possible, en VBA ou pas.
>> >> > MERCI.
>> >> >
>> >> > Yann
>> >>
>> >>
>> >>
>>
>>
>>

OK, je te remercie Daniel, mais sur "Recalcul", je ne défini ni la plage, ni
même la feuille sur laquelle il doit faire les recalcul ?

Merci
Yann

"Daniel.C" a écrit :

40, ce n'est pas rédhibitoire. Dans Thisworkbook, mets :

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For i = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next i
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
Recalcul
Application.EnableEvents = True
End Sub

Dans un mmodule, mets :

Sub Recalcul()
Dim c As Range, Largeur As Double, Hauteur As Single
Dim Cel As Range, sh As Worksheet, ResAdr As String
For Each sh In Sheets
With Application.FindFormat
.WrapText = True
.MergeCells = True
End With
Set Cel = sh.Cells.Find("*", SearchFormat:=True)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Var = Cel.Address
r = sh.Name
If Cel.HasFormula = True Then
For i = 1 To Cel.MergeArea.Columns.Count
Largeur = Largeur + Cel.ColumnWidth
Next i
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count,
..Columns.Count).Address).Offset(1)
Var = c.Address
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Cel.Value
Cel.EntireRow.RowHeight = c.Height
c.Clear
End With
End If
Set Cel = sh.Cells.Find("*", after:Îl, SearchFormat:=True)
'Set Cel = Cells.FindNext(Cel)
Loop While Cel.Address <> ResAdr
End If
Next sh
End Sub

Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 303D2719-E2FE-48EE-9778-75C743B40759@microsoft.com...
> Ah oui, je vois.
> J'ai 40 cellules (fusionnées bien sûr, de la colonne B à L), qui s'étalent
> de la ligne 52 à 109).
> Ben sinon, si c'est pas possible, je vais voir pour faire autrement, j'ai
> de
> la réflexion dans l'air si c'est le cas, lol .....
>
> Merci
> YANN
>
> "Daniel.C" a écrit :
>
>> Le seul moyen de s'en sortir est de recalculer la taille de toutes ces
>> cellules à chaque recalcul, ce qui implique de les rechercher en balayant
>> l'ensemble du classeur, ce qui va ralentir considérablement tout
>> recalcul, à
>> moins que tu aies peu de cellules concernées.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
>> news: 007FD70D-5979-47EA-8791-F66588A1CCED@microsoft.com...
>> > Daniel,
>> > ça fonctionne vraiment très très bien.
>> > Encore un petit truc
>> > Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la
>> > ligne
>> > auto, qui sont en fait des reprises de celulles d'autres pages, des
>> > celulles
>> > du même type, c'est à dire fusionnée avec remise auto à la ligne.
>> > par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62 se
>> > mette à jour de ce que j'ai saisi en feuille "20", B44.
>> >
>> > je pensais à F9, uniquement pour la feuille "GA01", mais ça ne marche
>> > pas.
>> >
>> > Merci.
>> >
>> >
>> > "Daniel.C" a écrit :
>> >
>> >> Dans "thisworkbook", mets :
>> >>
>> >> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As
>> >> Range)
>> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
>> >> For i = 1 To Target.MergeArea.Columns.Count
>> >> Largeur = Largeur + Target.ColumnWidth
>> >> Next i
>> >> Application.EnableEvents = False
>> >> With ActiveSheet.UsedRange
>> >> Set c = Range(.Cells(.Rows.Count,
>> >> .Columns.Count).Address).Offset(1,
>> >> 1)
>> >> c.ColumnWidth = Largeur
>> >> c.WrapText = True
>> >> c.Value = Target.Value
>> >> Target.EntireRow.RowHeight = c.Height
>> >> c.Clear
>> >> End With
>> >> Application.EnableEvents = True
>> >> End Sub
>> >>
>> >> Cordialement.
>> >> Daniel
>> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message
>> >> de
>> >> news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
>> >> > Impecable, ça focntionne.
>> >> > Désolé pour la question d'avant, il suffit de saisir un truc dans la
>> >> > celulle, nickel crome !!!!
>> >> >
>> >> > Et, on peut lui demander vite pour que ça fonctionne pour une page
>> >> > entière,
>> >> > voir le classeur entier, seulement pour les celulles qui sont en
>> >> > "renvoyer
>> >> > à
>> >> > la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>> >> >
>> >> > MERCI..
>> >> >
>> >> > ....
>> >> > Par contre, le 16/09, j'avais mis un post pour un problème
>> >> > d'impression.
>> >> > Ta
>> >> > réponse et celle d'un autre du forum m'aide, mais ne fonctionne pas,
>> >> > car
>> >> > le
>> >> > fait que NA soit saisi ou pas dans la celule A4,il imprime la
>> >> > feuille
>> >> > quand
>> >> > même.
>> >> > Donc si tu as une autre idée pour moi, merci d'avance.
>> >> > YANN
>> >> >
>> >> >
>> >> >
>> >> > "Daniel.C" a écrit :
>> >> >
>> >> >> Mets le code suivant dans le module de ta feuille :
>> >> >>
>> >> >> Private Sub Worksheet_Change(ByVal Target As Range)
>> >> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> >> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit Sub
>> >> >> Application.EnableEvents = False
>> >> >> Largeur = 10.71 * 8
>> >> >> Hauteur = 15
>> >> >> With ActiveSheet.UsedRange
>> >> >> Set c = Range(.Cells(.Rows.Count,
>> >> >> .Columns.Count).Address).Offset(1,
>> >> >> 1)
>> >> >> c.ColumnWidth = Largeur
>> >> >> c.WrapText = True
>> >> >> c.Value = Target.Value
>> >> >> Rows(22).RowHeight = c.Height
>> >> >> End With
>> >> >> Application.EnableEvents = True
>> >> >> End Sub
>> >> >>
>> >> >> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage
>> >> >> A22:H22.
>> >> >> --
>> >> >> Cordialement.
>> >> >> Daniel
>> >> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le
>> >> >> message
>> >> >> de
>> >> >> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> >> >> > Re,
>> >> >> > pour compléter, ça marche avec une celulle (j'avais oublié le
>> >> >> > "Format /
>> >> >> > lignes / ajustement automatique"), mais ça marche pas avec une
>> >> >> > ligne
>> >> >> > de
>> >> >> > celulles fusionnées.
>> >> >> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et je
>> >> >> > veux
>> >> >> > que
>> >> >> > ce
>> >> >> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >> >> >
>> >> >> > Est ce possible, en VBA ou pas.
>> >> >> > MERCI.
>> >> >> >
>> >> >> > Yann
>> >> >>
>> >> >>
>> >> >>
>> >>
>> >>
>> >>
>>
>>
>>

En fait, ce que j'ai voulu faire, et ça fonctionne chez moi, c'est que,
quand tu modifies une quelconque cellule ayant la propriété "renvoi à la
ligne automatique", la hauteur de la ligne s'ajuste, comme hier, et la macro
"recalcul" se déclenche, en recherchant toutes les cellules fusionnées et
ayant un renvoi automatique et une formule, et ajustant la hauteur de ces
cellules. Je t'envoie un classeur exemple si tu le désire.

Cordialement.
Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 8014E65A-8576-4500-8B16-ADE766DB220F@microsoft.com...

OK, je te remercie Daniel, mais sur "Recalcul", je ne défini ni la plage,
ni
même la feuille sur laquelle il doit faire les recalcul ?

Merci
Yann

"Daniel.C" a écrit :

40, ce n'est pas rédhibitoire. Dans Thisworkbook, mets :

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As
Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For i = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next i
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
Recalcul
Application.EnableEvents = True
End Sub

Dans un mmodule, mets :

Sub Recalcul()
Dim c As Range, Largeur As Double, Hauteur As Single
Dim Cel As Range, sh As Worksheet, ResAdr As String
For Each sh In Sheets
With Application.FindFormat
.WrapText = True
.MergeCells = True
End With
Set Cel = sh.Cells.Find("*", SearchFormat:=True)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Var = Cel.Address
r = sh.Name
If Cel.HasFormula = True Then
For i = 1 To Cel.MergeArea.Columns.Count
Largeur = Largeur + Cel.ColumnWidth
Next i
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count,
..Columns.Count).Address).Offset(1)
Var = c.Address
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Cel.Value
Cel.EntireRow.RowHeight = c.Height
c.Clear
End With
End If
Set Cel = sh.Cells.Find("*", after:Îl,
SearchFormat:=True)
'Set Cel = Cells.FindNext(Cel)
Loop While Cel.Address <> ResAdr
End If
Next sh
End Sub

Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 303D2719-E2FE-48EE-9778-75C743B40759@microsoft.com...
> Ah oui, je vois.
> J'ai 40 cellules (fusionnées bien sûr, de la colonne B à L), qui
> s'étalent
> de la ligne 52 à 109).
> Ben sinon, si c'est pas possible, je vais voir pour faire autrement,
> j'ai
> de
> la réflexion dans l'air si c'est le cas, lol .....
>
> Merci
> YANN
>
> "Daniel.C" a écrit :
>
>> Le seul moyen de s'en sortir est de recalculer la taille de toutes ces
>> cellules à chaque recalcul, ce qui implique de les rechercher en
>> balayant
>> l'ensemble du classeur, ce qui va ralentir considérablement tout
>> recalcul, à
>> moins que tu aies peu de cellules concernées.
>> Daniel
>> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message
>> de
>> news: 007FD70D-5979-47EA-8791-F66588A1CCED@microsoft.com...
>> > Daniel,
>> > ça fonctionne vraiment très très bien.
>> > Encore un petit truc
>> > Sur une de mes pages, j'ai des celulles fusionnées, avec remise à la
>> > ligne
>> > auto, qui sont en fait des reprises de celulles d'autres pages, des
>> > celulles
>> > du même type, c'est à dire fusionnée avec remise auto à la ligne.
>> > par exemple, en B62, j'ai ='20'!B44, et je voudrais que ma ligne B62
>> > se
>> > mette à jour de ce que j'ai saisi en feuille "20", B44.
>> >
>> > je pensais à F9, uniquement pour la feuille "GA01", mais ça ne
>> > marche
>> > pas.
>> >
>> > Merci.
>> >
>> >
>> > "Daniel.C" a écrit :
>> >
>> >> Dans "thisworkbook", mets :
>> >>
>> >> Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target
>> >> As
>> >> Range)
>> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
>> >> For i = 1 To Target.MergeArea.Columns.Count
>> >> Largeur = Largeur + Target.ColumnWidth
>> >> Next i
>> >> Application.EnableEvents = False
>> >> With ActiveSheet.UsedRange
>> >> Set c = Range(.Cells(.Rows.Count,
>> >> .Columns.Count).Address).Offset(1,
>> >> 1)
>> >> c.ColumnWidth = Largeur
>> >> c.WrapText = True
>> >> c.Value = Target.Value
>> >> Target.EntireRow.RowHeight = c.Height
>> >> c.Clear
>> >> End With
>> >> Application.EnableEvents = True
>> >> End Sub
>> >>
>> >> Cordialement.
>> >> Daniel
>> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le
>> >> message
>> >> de
>> >> news: 23D12604-9C58-4904-8EE1-F83FAC13C8D0@microsoft.com...
>> >> > Impecable, ça focntionne.
>> >> > Désolé pour la question d'avant, il suffit de saisir un truc dans
>> >> > la
>> >> > celulle, nickel crome !!!!
>> >> >
>> >> > Et, on peut lui demander vite pour que ça fonctionne pour une
>> >> > page
>> >> > entière,
>> >> > voir le classeur entier, seulement pour les celulles qui sont en
>> >> > "renvoyer
>> >> > à
>> >> > la ligne automatiquement", ça, ça serait la cerise sur le gateau.
>> >> >
>> >> > MERCI..
>> >> >
>> >> > ....
>> >> > Par contre, le 16/09, j'avais mis un post pour un problème
>> >> > d'impression.
>> >> > Ta
>> >> > réponse et celle d'un autre du forum m'aide, mais ne fonctionne
>> >> > pas,
>> >> > car
>> >> > le
>> >> > fait que NA soit saisi ou pas dans la celule A4,il imprime la
>> >> > feuille
>> >> > quand
>> >> > même.
>> >> > Donc si tu as une autre idée pour moi, merci d'avance.
>> >> > YANN
>> >> >
>> >> >
>> >> >
>> >> > "Daniel.C" a écrit :
>> >> >
>> >> >> Mets le code suivant dans le module de ta feuille :
>> >> >>
>> >> >> Private Sub Worksheet_Change(ByVal Target As Range)
>> >> >> Dim c As Range, Largeur As Double, Hauteur As Single
>> >> >> If Target.Address <> "$A$22" Or Target.Count > 1 Then Exit
>> >> >> Sub
>> >> >> Application.EnableEvents = False
>> >> >> Largeur = 10.71 * 8
>> >> >> Hauteur = 15
>> >> >> With ActiveSheet.UsedRange
>> >> >> Set c = Range(.Cells(.Rows.Count,
>> >> >> .Columns.Count).Address).Offset(1,
>> >> >> 1)
>> >> >> c.ColumnWidth = Largeur
>> >> >> c.WrapText = True
>> >> >> c.Value = Target.Value
>> >> >> Rows(22).RowHeight = c.Height
>> >> >> End With
>> >> >> Application.EnableEvents = True
>> >> >> End Sub
>> >> >>
>> >> >> Ca fonctionne si tu ne mêles pas pusieurs polices dans la plage
>> >> >> A22:H22.
>> >> >> --
>> >> >> Cordialement.
>> >> >> Daniel
>> >> >> "Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le
>> >> >> message
>> >> >> de
>> >> >> news: 202B9801-9C49-4319-8DC4-030D73748877@microsoft.com...
>> >> >> > Re,
>> >> >> > pour compléter, ça marche avec une celulle (j'avais oublié le
>> >> >> > "Format /
>> >> >> > lignes / ajustement automatique"), mais ça marche pas avec une
>> >> >> > ligne
>> >> >> > de
>> >> >> > celulles fusionnées.
>> >> >> > je m'explique : je fusionne 1 ligne, de la colonne A à H, et
>> >> >> > je
>> >> >> > veux
>> >> >> > que
>> >> >> > ce
>> >> >> > soit cette celulle fusionnée qui s'ajuste en hauteur.
>> >> >> >
>> >> >> > Est ce possible, en VBA ou pas.
>> >> >> > MERCI.
>> >> >> >
>> >> >> > Yann
>> >> >>
>> >> >>
>> >> >>
>> >>
>> >>
>> >>
>>
>>
>>

Ben, je veux bien, car chez moi, je viens juste de faire le test, et avec
"Recalcul", et ben les hauteurs de ligne ne s'ajustent plus du tout, sur
toutes mes cellules fusionnées.....
y'a eu une modif entre le code du début et celui-là, c'est pt_t à cause de
ça :
---
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
----
je te remet ce que j'ai en ce moment en VBA:
**thisworkbook:
---
'hauteur des lignes automatique
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For I = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next I
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
'Recalcul
Application.EnableEvents = True
End Sub
------
**module1
---
'Recalcul des cellules pages GA01
Sub Recalcul()
Dim c As Range, Largeur As Double, Hauteur As Single
Dim Cel As Range, sh As Worksheet, ResAdr As String
For Each sh In Sheets
With Application.FindFormat
.WrapText = True
.MergeCells = True
End With
Set Cel = sh.Cells.Find("*", SearchFormat:=True)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Var = Cel.Address
r = sh.Name
If Cel.HasFormula = True Then
For I = 1 To Cel.MergeArea.Columns.Count
Largeur = Largeur + Cel.ColumnWidth
Next I
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count,
.Columns.Count).Address).Offset(1)
Var = c.Address
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Cel.Value
Cel.EntireRow.RowHeight = c.Height
c.Clear
End With
End If
Set Cel = sh.Cells.Find("*", after:Îl, SearchFormat:=True)
Set Cel = Cells.FindNext(Cel)
Loop While Cel.Address <> ResAdr
End If
Next sh
End Sub
------


"Daniel.C" a écrit :

En fait, ce que j'ai voulu faire, et ça fonctionne chez moi, c'est que,
quand tu modifies une quelconque cellule ayant la propriété "renvoi à la
ligne automatique", la hauteur de la ligne s'ajuste, comme hier, et la macro
"recalcul" se déclenche, en recherchant toutes les cellules fusionnées et
ayant un renvoi automatique et une formule, et ajustant la hauteur de ces
cellules. Je t'envoie un classeur exemple si tu le désire.

Cordialement.
Daniel

Tout se fait automatiquement, tu n'as pas à exécuter la macro Recalcul :
http://cjoint.com/?jAp46LTEL4


Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: F417F111-ABE5-4F75-9DDD-E08C4072A464@microsoft.com...

Ben, je veux bien, car chez moi, je viens juste de faire le test, et avec
"Recalcul", et ben les hauteurs de ligne ne s'ajustent plus du tout, sur
toutes mes cellules fusionnées.....
y'a eu une modif entre le code du début et celui-là, c'est pt_t à cause de
ça :
---
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
----
je te remet ce que j'ai en ce moment en VBA:
**thisworkbook:
---
'hauteur des lignes automatique
Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As
Range)
Dim c As Range, Largeur As Double, Hauteur As Single
If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
For I = 1 To Target.MergeArea.Columns.Count
Largeur = Largeur + Target.ColumnWidth
Next I
Application.EnableEvents = False
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Target.Value
Target.EntireRow.RowHeight = c.Height
c.Clear
End With
'Recalcul
Application.EnableEvents = True
End Sub
------
**module1
---
'Recalcul des cellules pages GA01
Sub Recalcul()
Dim c As Range, Largeur As Double, Hauteur As Single
Dim Cel As Range, sh As Worksheet, ResAdr As String
For Each sh In Sheets
With Application.FindFormat
.WrapText = True
.MergeCells = True
End With
Set Cel = sh.Cells.Find("*", SearchFormat:=True)
If Not Cel Is Nothing Then
ResAdr = Cel.Address
Do
Var = Cel.Address
r = sh.Name
If Cel.HasFormula = True Then
For I = 1 To Cel.MergeArea.Columns.Count
Largeur = Largeur + Cel.ColumnWidth
Next I
With ActiveSheet.UsedRange
Set c = Range(.Cells(.Rows.Count,
.Columns.Count).Address).Offset(1)
Var = c.Address
c.ColumnWidth = Largeur
c.WrapText = True
c.Value = Cel.Value
Cel.EntireRow.RowHeight = c.Height
c.Clear
End With
End If
Set Cel = sh.Cells.Find("*", after:Îl,
SearchFormat:=True)
Set Cel = Cells.FindNext(Cel)
Loop While Cel.Address <> ResAdr
End If
Next sh
End Sub
------


"Daniel.C" a écrit :

En fait, ce que j'ai voulu faire, et ça fonctionne chez moi, c'est que,
quand tu modifies une quelconque cellule ayant la propriété "renvoi à la
ligne automatique", la hauteur de la ligne s'ajuste, comme hier, et la
macro
"recalcul" se déclenche, en recherchant toutes les cellules fusionnées et
ayant un renvoi automatique et une formule, et ajustant la hauteur de ces
cellules. Je t'envoie un classeur exemple si tu le désire.

Cordialement.
Daniel

Salut
je vpois que ça fonctionne sur ton exemple.
Je viens de reprendre exactement ton code macro, il plante là dans le module :
---
Loop While Cel.Address <> ResAdr
-----
moi ma cellule où il y a le "=xxx" est sur une autre feuille.
Je te joins ton modèle, j'ai juste mis le "=xxx" sur la feuille 5...
Et il en manque un bout..
http://cjoint.com/data/jAqv3BWdJh.htm
Dis-moi si y'a un truc ke je fais mal ?
Merci YANN


"Daniel.C" a écrit :

Tout se fait automatiquement, tu n'as pas à exécuter la macro Recalcul :
http://cjoint.com/?jAp46LTEL4


Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: F417F111-ABE5-4F75-9DDD-E08C4072A464@microsoft.com...
> Ben, je veux bien, car chez moi, je viens juste de faire le test, et avec
> "Recalcul", et ben les hauteurs de ligne ne s'ajustent plus du tout, sur
> toutes mes cellules fusionnées.....
> y'a eu une modif entre le code du début et celui-là, c'est pt_t à cause de
> ça :
> ---
> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
> ----
> je te remet ce que j'ai en ce moment en VBA:
> **thisworkbook:
> ---
> 'hauteur des lignes automatique
> Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As
> Range)
> Dim c As Range, Largeur As Double, Hauteur As Single
> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
> For I = 1 To Target.MergeArea.Columns.Count
> Largeur = Largeur + Target.ColumnWidth
> Next I
> Application.EnableEvents = False
> With ActiveSheet.UsedRange
> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1, 1)
> c.ColumnWidth = Largeur
> c.WrapText = True
> c.Value = Target.Value
> Target.EntireRow.RowHeight = c.Height
> c.Clear
> End With
> 'Recalcul
> Application.EnableEvents = True
> End Sub
> ------
> **module1
> ---
> 'Recalcul des cellules pages GA01
> Sub Recalcul()
> Dim c As Range, Largeur As Double, Hauteur As Single
> Dim Cel As Range, sh As Worksheet, ResAdr As String
> For Each sh In Sheets
> With Application.FindFormat
> .WrapText = True
> .MergeCells = True
> End With
> Set Cel = sh.Cells.Find("*", SearchFormat:=True)
> If Not Cel Is Nothing Then
> ResAdr = Cel.Address
> Do
> Var = Cel.Address
> r = sh.Name
> If Cel.HasFormula = True Then
> For I = 1 To Cel.MergeArea.Columns.Count
> Largeur = Largeur + Cel.ColumnWidth
> Next I
> With ActiveSheet.UsedRange
> Set c = Range(.Cells(.Rows.Count,
> .Columns.Count).Address).Offset(1)
> Var = c.Address
> c.ColumnWidth = Largeur
> c.WrapText = True
> c.Value = Cel.Value
> Cel.EntireRow.RowHeight = c.Height
> c.Clear
> End With
> End If
> Set Cel = sh.Cells.Find("*", after:Îl,
> SearchFormat:=True)
> Set Cel = Cells.FindNext(Cel)
> Loop While Cel.Address <> ResAdr
> End If
> Next sh
> End Sub
> ------
>
>
> "Daniel.C" a écrit :
>
>> En fait, ce que j'ai voulu faire, et ça fonctionne chez moi, c'est que,
>> quand tu modifies une quelconque cellule ayant la propriété "renvoi à la
>> ligne automatique", la hauteur de la ligne s'ajuste, comme hier, et la
>> macro
>> "recalcul" se déclenche, en recherchant toutes les cellules fusionnées et
>> ayant un renvoi automatique et une formule, et ajustant la hauteur de ces
>> cellules. Je t'envoie un classeur exemple si tu le désire.
>>
>> Cordialement.
>> Daniel
>>

Exact. J'ai effectué une petite (deux) correction(s) :
http://cjoint.com/?jBax2SCuPk

Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: 07C2E25D-FAA8-41F5-99B5-79F8B4E02548@microsoft.com...

Salut
je vpois que ça fonctionne sur ton exemple.
Je viens de reprendre exactement ton code macro, il plante là dans le
module :
---
Loop While Cel.Address <> ResAdr
-----
moi ma cellule où il y a le "=xxx" est sur une autre feuille.
Je te joins ton modèle, j'ai juste mis le "=xxx" sur la feuille 5...
Et il en manque un bout..
http://cjoint.com/data/jAqv3BWdJh.htm
Dis-moi si y'a un truc ke je fais mal ?
Merci YANN


"Daniel.C" a écrit :

Tout se fait automatiquement, tu n'as pas à exécuter la macro Recalcul :
http://cjoint.com/?jAp46LTEL4


Daniel
"Sunburn" <Sunburn@discussions.microsoft.com> a écrit dans le message de
news: F417F111-ABE5-4F75-9DDD-E08C4072A464@microsoft.com...
> Ben, je veux bien, car chez moi, je viens juste de faire le test, et
> avec
> "Recalcul", et ben les hauteurs de ligne ne s'ajustent plus du tout,
> sur
> toutes mes cellules fusionnées.....
> y'a eu une modif entre le code du début et celui-là, c'est pt_t à cause
> de
> ça :
> ---
> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1,
> 1)
> ----
> je te remet ce que j'ai en ce moment en VBA:
> **thisworkbook:
> ---
> 'hauteur des lignes automatique
> Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As
> Range)
> Dim c As Range, Largeur As Double, Hauteur As Single
> If Target.WrapText = False Or Target.Count > 1 Then Exit Sub
> For I = 1 To Target.MergeArea.Columns.Count
> Largeur = Largeur + Target.ColumnWidth
> Next I
> Application.EnableEvents = False
> With ActiveSheet.UsedRange
> Set c = Range(.Cells(.Rows.Count, .Columns.Count).Address).Offset(1,
> 1)
> c.ColumnWidth = Largeur
> c.WrapText = True
> c.Value = Target.Value
> Target.EntireRow.RowHeight = c.Height
> c.Clear
> End With
> 'Recalcul
> Application.EnableEvents = True
> End Sub
> ------
> **module1
> ---
> 'Recalcul des cellules pages GA01
> Sub Recalcul()
> Dim c As Range, Largeur As Double, Hauteur As Single
> Dim Cel As Range, sh As Worksheet, ResAdr As String
> For Each sh In Sheets
> With Application.FindFormat
> .WrapText = True
> .MergeCells = True
> End With
> Set Cel = sh.Cells.Find("*", SearchFormat:=True)
> If Not Cel Is Nothing Then
> ResAdr = Cel.Address
> Do
> Var = Cel.Address
> r = sh.Name
> If Cel.HasFormula = True Then
> For I = 1 To Cel.MergeArea.Columns.Count
> Largeur = Largeur + Cel.ColumnWidth
> Next I
> With ActiveSheet.UsedRange
> Set c = Range(.Cells(.Rows.Count,
> .Columns.Count).Address).Offset(1)
> Var = c.Address
> c.ColumnWidth = Largeur
> c.WrapText = True
> c.Value = Cel.Value
> Cel.EntireRow.RowHeight = c.Height
> c.Clear
> End With
> End If
> Set Cel = sh.Cells.Find("*", after:Îl,
> SearchFormat:=True)
> Set Cel = Cells.FindNext(Cel)
> Loop While Cel.Address <> ResAdr
> End If
> Next sh
> End Sub
> ------
>
>
> "Daniel.C" a écrit :
>
>> En fait, ce que j'ai voulu faire, et ça fonctionne chez moi, c'est
>> que,
>> quand tu modifies une quelconque cellule ayant la propriété "renvoi à
>> la
>> ligne automatique", la hauteur de la ligne s'ajuste, comme hier, et la
>> macro
>> "recalcul" se déclenche, en recherchant toutes les cellules fusionnées
>> et
>> ayant un renvoi automatique et une formule, et ajustant la hauteur de
>> ces
>> cellules. Je t'envoie un classeur exemple si tu le désire.
>>
>> Cordialement.
>> Daniel
>>