VBA nombre de lignes (retours) dans la cellule

bonjour LSteph,

est ce que cette ligne fonctionne ?

Columns("E:E").Rows.AutoFit

sinon pour compter :

nombreDeLigne = Application.CountA(Range("A1"), Chr(10))
nombreDeRetourÀLaLigne = Application.CountA(Range("A1"), Chr(10)) - 1

isabelle

LSteph a écrit :

Bonjour,

Excel est avant tout un tableur , mais certains utilisateurs dans des
tableaux déjà fort grands utilisent parfois une colonne pour y rentrer
des observations qui peuvent s'averer un peu longues.
Or, lorsque le contenu d'une cellule est un peu long et en supposant
qu'on a fixé une largeur et utilisé le renvoi à la ligne , lorsque
l'on veut alors procèder à un ajustement automatique de cette ligne,
Excel 2003 ne fait pas correctement cet ajustement, il reste du texte
qui n'apparaît pas sauf si on augmente manuellement la hauteur de
ligne.

Quelqu'un saurait il en VBA quelle propriété donnerait le nombre de
lignes ou renvois à la ligne (Alt+Entrée inclus) découlant du contenu
de la cellule. Le but serait lorsque le nécessaire excède la partie
visible de réajuster directement la hauteur, puisque je connais la
taille de la police utilisée et la hauteur standard de ligne qui en
découle.
In fine cela me permettra d'adapter une procedure pour chaque
cellule d'une colonne distinctement.

Merci d'avance.

--
lSteph

Bonsoir Isabelle,

Merci de ton intérêt pour cette question.

Précisément .Rows.AutoFit
quand le texte est un peu long ne fait pas correctement cet ajustement,
il reste du texte de même manuellement.

> Application.CountA(Range("A1"), Chr(10))
Compter les chr(10) me renvoie uniquement ceux-cis mais pas les autres
retours. Exemple les 17 premieres lignes de mon précédent post écrites
dans une cellule me renvoie qu'il y a 2 retours.
Alors que selon la largeur il peut y en avoir bien plus.

Merci.

--
lSteph




isabelle a écrit :

bonjour LSteph,

est ce que cette ligne fonctionne ?

Columns("E:E").Rows.AutoFit

sinon pour compter :

nombreDeLigne = Application.CountA(Range("A1"), Chr(10))
nombreDeRetourÀLaLigne = Application.CountA(Range("A1"), Chr(10)) - 1

isabelle

LSteph a écrit :

Bonjour,

Excel est avant tout un tableur , mais certains utilisateurs dans des
tableaux déjà fort grands utilisent parfois une colonne pour y rentrer
des observations qui peuvent s'averer un peu longues.
Or, lorsque le contenu d'une cellule est un peu long et en supposant
qu'on a fixé une largeur et utilisé le renvoi à la ligne , lorsque
l'on veut alors procèder à un ajustement automatique de cette ligne,
Excel 2003 ne fait pas correctement cet ajustement, il reste du texte
qui n'apparaît pas sauf si on augmente manuellement la hauteur de
ligne.

Quelqu'un saurait il en VBA quelle propriété donnerait le nombre de
lignes ou renvois à la ligne (Alt+Entrée inclus) découlant du contenu
de la cellule. Le but serait lorsque le nécessaire excède la partie
visible de réajuster directement la hauteur, puisque je connais la
taille de la police utilisée et la hauteur standard de ligne qui en
découle.
In fine cela me permettra d'adapter une procedure pour chaque
cellule d'une colonne distinctement.

Merci d'avance.

--
lSteph

ok, je comprend mieux ce que tu veut dire,
desolé je ne voie pas de solution,

isabelle

LSteph a écrit :

Bonsoir Isabelle,

Merci de ton intérêt pour cette question.

Précisément .Rows.AutoFit
quand le texte est un peu long ne fait pas correctement cet
ajustement, il reste du texte de même manuellement.

> Application.CountA(Range("A1"), Chr(10))
Compter les chr(10) me renvoie uniquement ceux-cis mais pas les
autres retours. Exemple les 17 premieres lignes de mon précédent post
écrites dans une cellule me renvoie qu'il y a 2 retours.
Alors que selon la largeur il peut y en avoir bien plus.

Merci.

--
lSteph




isabelle a écrit :

bonjour LSteph,

est ce que cette ligne fonctionne ?

Columns("E:E").Rows.AutoFit

sinon pour compter :

nombreDeLigne = Application.CountA(Range("A1"), Chr(10))
nombreDeRetourÀLaLigne = Application.CountA(Range("A1"), Chr(10)) - 1

isabelle

LSteph a écrit :

Bonjour,

Excel est avant tout un tableur , mais certains utilisateurs dans des
tableaux déjà fort grands utilisent parfois une colonne pour y rentrer
des observations qui peuvent s'averer un peu longues.
Or, lorsque le contenu d'une cellule est un peu long et en supposant
qu'on a fixé une largeur et utilisé le renvoi à la ligne , lorsque
l'on veut alors procèder à un ajustement automatique de cette ligne,
Excel 2003 ne fait pas correctement cet ajustement, il reste du texte
qui n'apparaît pas sauf si on augmente manuellement la hauteur de
ligne.

Quelqu'un saurait il en VBA quelle propriété donnerait le nombre de
lignes ou renvois à la ligne (Alt+Entrée inclus) découlant du contenu
de la cellule. Le but serait lorsque le nécessaire excède la partie
visible de réajuster directement la hauteur, puisque je connais la
taille de la police utilisée et la hauteur standard de ligne qui en
découle.
In fine cela me permettra d'adapter une procedure pour chaque
cellule d'une colonne distinctement.

Merci d'avance.

--
lSteph

ou peut être si cette colonne est au format "Terminal",
il y aurait surement un moyen de calculer le nombre de pixcel par caractere,
mais par contre il y a surement, selon la carte graphique, une différence,
sur mon pc il y a une différence de 0.71 pixcel par caractere,

en tout cas, ce n'est pas évident, je vient de me souvenir que geedee
avait ecrit quelque chose sur ce sujet,
je cherche et revient pour conclure,

isabelle

isabelle a écrit :

ok, je comprend mieux ce que tu veut dire,
desolé je ne voie pas de solution,

isabelle

LSteph a écrit :

Bonsoir Isabelle,

Merci de ton intérêt pour cette question.

Précisément .Rows.AutoFit
quand le texte est un peu long ne fait pas correctement cet
ajustement, il reste du texte de même manuellement.

> Application.CountA(Range("A1"), Chr(10))
Compter les chr(10) me renvoie uniquement ceux-cis mais pas les
autres retours. Exemple les 17 premieres lignes de mon précédent
post écrites dans une cellule me renvoie qu'il y a 2 retours.
Alors que selon la largeur il peut y en avoir bien plus.

Merci.

--
lSteph




isabelle a écrit :

bonjour LSteph,

est ce que cette ligne fonctionne ?

Columns("E:E").Rows.AutoFit

sinon pour compter :

nombreDeLigne = Application.CountA(Range("A1"), Chr(10))
nombreDeRetourÀLaLigne = Application.CountA(Range("A1"), Chr(10)) - 1

isabelle

LSteph a écrit :

Bonjour,

Excel est avant tout un tableur , mais certains utilisateurs dans des
tableaux déjà fort grands utilisent parfois une colonne pour y rentrer
des observations qui peuvent s'averer un peu longues.
Or, lorsque le contenu d'une cellule est un peu long et en supposant
qu'on a fixé une largeur et utilisé le renvoi à la ligne , lorsque
l'on veut alors procèder à un ajustement automatique de cette ligne,
Excel 2003 ne fait pas correctement cet ajustement, il reste du texte
qui n'apparaît pas sauf si on augmente manuellement la hauteur de
ligne.

Quelqu'un saurait il en VBA quelle propriété donnerait le nombre de
lignes ou renvois à la ligne (Alt+Entrée inclus) découlant du contenu
de la cellule. Le but serait lorsque le nécessaire excède la partie
visible de réajuster directement la hauteur, puisque je connais la
taille de la police utilisée et la hauteur standard de ligne qui en
découle.
In fine cela me permettra d'adapter une procedure pour chaque
cellule d'une colonne distinctement.

Merci d'avance.

--
lSteph

voilà j'ai retrouvé ce texte de geedee,
___________________________________________________________________________

le pixel dépend en effet de la partie physique, donc variable selon le
périphérique(marque, résolution)
le Twips est screen-independent (1440 twips par pouce, ou 567 twips par cm)
selon le periphérique il y a donc une relation variable pixel/twips
!!!!
supreme raffinement les pixels ne sont pas circulaires mais ovales !!!!!

http://support.microsoft.com/kb/463203/fr
http://support.microsoft.com/kb/210590
http://support.microsoft.com/default.aspx?scid=kb;en-us;Q94927

Le twip logique
Une unité de distance, reposant sur twips, qui lors de l'impression, équivaut à
un twip.
Cela permet de s'assurer que le placement et la proportion d'éléments d'écran
dans l'écran d'affichage de la même application sur tous les systèmes.
A unit of distance, based on twips, that when printed, equals one twip.
This ensures that placement and proportion of screen elements in your screen
application display the same on all systems.

Un twip est une unité de longueur égale à 1 / 20 d'une imprimante, une
imprimante et le point est 1 / 72 de pouce. Il ya environ 1440 twips à une
logique pouces ou 567 twips à une logique centimètre (la longueur d'un élément
d'écran, mesurant un pouce ou d'un centimètre lors de l'impression).
A twip is a unit of length equal to 1/20 of a printer's point, and a printer's
point is 1/72 of an inch. There are approximately 1440 twips to a logical inch
or 567 twips to a logical centimeter (the length of a screen item measuring one
inch or one centimeter when printed).

Toute unité de mesure absolue, comme les pouces, centimètres ou twips, n'est pas
nécessairement compatible lorsqu'ils traitent avec les périphériques externes
tels que des moniteurs ou des imprimantes. Si, par exemple, vous programmez la
dessiner une ligne d'un pouce sur l'écran, le mesurer avec une règle pour
s'assurer qu'elle est un pouce, puis passez à un plus grand écran, la ligne ne
sera plus un pouce. Par conséquent, l'une logique twip peut être constituée
d'une ou plusieurs twips.
Any absolute unit of measurement, such as inches, centimeters, or twips, is not
necessarily consistent when dealing with external devices such as monitors or
printers. If, for example, you programmatically draw a one inch line on a
monitor, measure it with a ruler to ensure that it is one inch, then switch to a
larger monitor, the line will no longer be one inch. Therefore, one logical twip
may consist of one or more twips.

____________________________________________________________________________________
ps/ ne pas oublier qu'un caractère demeure un objet dessiner à l'écran
en pixel
isabelle

isabelle a écrit :

ok, je comprend mieux ce que tu veut dire,
desolé je ne voie pas de solution,

isabelle

LSteph a écrit :

Bonsoir Isabelle,

Merci de ton intérêt pour cette question.

Précisément .Rows.AutoFit
quand le texte est un peu long ne fait pas correctement cet
ajustement, il reste du texte de même manuellement.

> Application.CountA(Range("A1"), Chr(10))
Compter les chr(10) me renvoie uniquement ceux-cis mais pas les
autres retours. Exemple les 17 premieres lignes de mon précédent
post écrites dans une cellule me renvoie qu'il y a 2 retours.
Alors que selon la largeur il peut y en avoir bien plus.

Merci.

--
lSteph




isabelle a écrit :

bonjour LSteph,

est ce que cette ligne fonctionne ?

Columns("E:E").Rows.AutoFit

sinon pour compter :

nombreDeLigne = Application.CountA(Range("A1"), Chr(10))
nombreDeRetourÀLaLigne = Application.CountA(Range("A1"), Chr(10)) - 1

isabelle

LSteph a écrit :

Bonjour,

Excel est avant tout un tableur , mais certains utilisateurs dans des
tableaux déjà fort grands utilisent parfois une colonne pour y rentrer
des observations qui peuvent s'averer un peu longues.
Or, lorsque le contenu d'une cellule est un peu long et en supposant
qu'on a fixé une largeur et utilisé le renvoi à la ligne , lorsque
l'on veut alors procèder à un ajustement automatique de cette ligne,
Excel 2003 ne fait pas correctement cet ajustement, il reste du texte
qui n'apparaît pas sauf si on augmente manuellement la hauteur de
ligne.

Quelqu'un saurait il en VBA quelle propriété donnerait le nombre de
lignes ou renvois à la ligne (Alt+Entrée inclus) découlant du contenu
de la cellule. Le but serait lorsque le nécessaire excède la partie
visible de réajuster directement la hauteur, puisque je connais la
taille de la police utilisée et la hauteur standard de ligne qui en
découle.
In fine cela me permettra d'adapter une procedure pour chaque
cellule d'une colonne distinctement.

Merci d'avance.

--
lSteph

et celui-ci de notre grand chef à quatre plumes,
------------------------------------------------------------------------------------------------------------
'Laurent Longre
'Date : 1999/11/30
'Objet : Re: Q: longueur en pixel ou en points d'un texte
'=================================================
Type Size
cx As Long
cy As Long
End Type

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Function LgTexte(Texte As String, Optional Police, _
Optional Taille, Optional Gras As Boolean, _
Optional Italique As Boolean)
Dim hFont As Long
Dim hDC As Long
Dim TSize As Size
Dim PixpInch As Double
With ActiveWorkbook.Styles("Normal").Font
If IsMissing(Police) Then Police = .Name
If IsMissing(Taille) Then Taille = .Font.Size
End With
hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
DeleteObject hFont
ReleaseDC 0, hDC
LgTexte = TSize.cx / PixpInch
End Function

Function LgTexteCellule(Cellule As Range)
With Cellule.Font
LgTexteCellule = LgTexte(Cellule.Text, .Name, .Size, .Bold, .Italic)
End With
End Function

Sub Test()
Dim Cell As Range
Application.ScreenUpdating = False
Worksheets.Add
Range("B1") = "Longueur (points)"
Range("B1").Font.Bold = True
With Range("A2:A15")
.Value = "Zaza Excelle dans l'art de miouquer."
.Font.Name = "Times New Roman"
End With
For Each Cell In Range("A2:A15")
Cell.Font.Size = Cell.Row + 6
Cell(1, 2) = LgTexteCellule(Cell)
Next Cell
Range("A:B").EntireColumn.AutoFit
End Sub
'=================================================
La fonction LgTexte(Texte, Police, Taille, Gras , Italique) renvoie la
longueur en points du texte transmis, selon les paramètres de police,
taille et format (Gras et Italique: True / False). Par défaut, elle
prend la police standard d'Excel et sa taille, caractères normaux non
italiques.

La fonction LgTexteCellule(Cellule) renvoie la longueur en points du
texte de la cellule en fonction de sa police et de son format. Celui-ci
doit évidemment être uniforme (tous les caractères dans le même format,
la même taille et la même police).

Pour comparer la valeur renvoyée à la largeur d'une colonne, utiliser la
propriété Width de la colonne ou de l'une de ses cellules:
Range("A1").Width.

J 'ai constaté que ma fonction appliquée sur une cellule (par exemple A1)
renvoie une valeur très légèrement inférieure à Range("A1").Width quand
la largeur de la colonne est ajustée au texte de A1, Excel rajoutant
automatiquement une légère marge à gauche et à droite des cellules. Je
ne sais pas comment calculer cette marge. La différence est d'environ
+1-2% par rapport à la longueur renvoyée par LgTexteCellule avec les
polices de taille usuelle (entre 8 et 14 points). En-dessous, elle peut
être un peu plus importante.

En espérant que ce te soit utile...

Laurent
-----------------------------------------------------------------------------------------
isabelle

Bonjour,

Peux-tu essayer cette procédure qui me semble fonctionner à souhaits sous
2003 (pas testée sur les autres ...)

-> en supposant que les commentaires sont en colonne A (à adapter sinon) :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("A:A")) Is Nothing And Target.Count = 1
Then
With Columns("A:A")
.ColumnWidth = 200
'largeur nécessairement surdimensionnée par rapport à ce que
plausible
.AutoFit
End With
With Target.Rows
.RowHeight = 200 ' bis repetita
.AutoFit
End With
Target.Select
End If
End Sub

J'ai testé et cela marche ; si c'est bien ce que tu recherches ... ?

Qu'en penses-tu ?

Essart


"isabelle" <i@v> a écrit dans le message de news:
ekWJ3szNKHA.4964@TK2MSFTNGP06.phx.gbl...

et celui-ci de notre grand chef à quatre plumes,
------------------------------------------------------------------------------------------------------------
'Laurent Longre
'Date : 1999/11/30
'Objet : Re: Q: longueur en pixel ou en points d'un texte
'================================================= >
Type Size
cx As Long
cy As Long
End Type

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Function LgTexte(Texte As String, Optional Police, _
Optional Taille, Optional Gras As Boolean, _
Optional Italique As Boolean)
Dim hFont As Long
Dim hDC As Long
Dim TSize As Size
Dim PixpInch As Double
With ActiveWorkbook.Styles("Normal").Font
If IsMissing(Police) Then Police = .Name
If IsMissing(Taille) Then Taille = .Font.Size
End With
hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
DeleteObject hFont
ReleaseDC 0, hDC
LgTexte = TSize.cx / PixpInch
End Function

Function LgTexteCellule(Cellule As Range)
With Cellule.Font
LgTexteCellule = LgTexte(Cellule.Text, .Name, .Size, .Bold, .Italic)
End With
End Function

Sub Test()
Dim Cell As Range
Application.ScreenUpdating = False
Worksheets.Add
Range("B1") = "Longueur (points)"
Range("B1").Font.Bold = True
With Range("A2:A15")
.Value = "Zaza Excelle dans l'art de miouquer."
.Font.Name = "Times New Roman"
End With
For Each Cell In Range("A2:A15")
Cell.Font.Size = Cell.Row + 6
Cell(1, 2) = LgTexteCellule(Cell)
Next Cell
Range("A:B").EntireColumn.AutoFit
End Sub
'================================================= >
La fonction LgTexte(Texte, Police, Taille, Gras , Italique) renvoie la
longueur en points du texte transmis, selon les paramètres de police,
taille et format (Gras et Italique: True / False). Par défaut, elle
prend la police standard d'Excel et sa taille, caractères normaux non
italiques.

La fonction LgTexteCellule(Cellule) renvoie la longueur en points du
texte de la cellule en fonction de sa police et de son format. Celui-ci
doit évidemment être uniforme (tous les caractères dans le même format,
la même taille et la même police).

Pour comparer la valeur renvoyée à la largeur d'une colonne, utiliser la
propriété Width de la colonne ou de l'une de ses cellules:
Range("A1").Width.

J 'ai constaté que ma fonction appliquée sur une cellule (par exemple A1)
renvoie une valeur très légèrement inférieure à Range("A1").Width quand
la largeur de la colonne est ajustée au texte de A1, Excel rajoutant
automatiquement une légère marge à gauche et à droite des cellules. Je
ne sais pas comment calculer cette marge. La différence est d'environ
+1-2% par rapport à la longueur renvoyée par LgTexteCellule avec les
polices de taille usuelle (entre 8 et 14 points). En-dessous, elle peut
être un peu plus importante.

En espérant que ce te soit utile...

Laurent
-----------------------------------------------------------------------------------------
isabelle

Oups ...

J'ai oublié de supprimer dans le mail le :
Target.Select
de fin de procédure que j'avais mis pour les tests ...
(juste pour éviter de remplir des pages !)

Essart

"Essart" <sans@mail.fr> a écrit dans le message de news:
%23M2qpl1NKHA.352@TK2MSFTNGP02.phx.gbl...

Bonjour,

Peux-tu essayer cette procédure qui me semble fonctionner à souhaits sous
2003 (pas testée sur les autres ...)

-> en supposant que les commentaires sont en colonne A (à adapter sinon) :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("A:A")) Is Nothing And Target.Count = 1
Then
With Columns("A:A")
.ColumnWidth = 200
'largeur nécessairement surdimensionnée par rapport à ce que
plausible
.AutoFit
End With
With Target.Rows
.RowHeight = 200 ' bis repetita
.AutoFit
End With
Target.Select
End If
End Sub

J'ai testé et cela marche ; si c'est bien ce que tu recherches ... ?

Qu'en penses-tu ?

Essart


"isabelle" <i@v> a écrit dans le message de news:
ekWJ3szNKHA.4964@TK2MSFTNGP06.phx.gbl...

et celui-ci de notre grand chef à quatre plumes,
------------------------------------------------------------------------------------------------------------
'Laurent Longre
'Date : 1999/11/30
'Objet : Re: Q: longueur en pixel ou en points d'un texte
'================================================= >>
Type Size
cx As Long
cy As Long
End Type

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Function LgTexte(Texte As String, Optional Police, _
Optional Taille, Optional Gras As Boolean, _
Optional Italique As Boolean)
Dim hFont As Long
Dim hDC As Long
Dim TSize As Size
Dim PixpInch As Double
With ActiveWorkbook.Styles("Normal").Font
If IsMissing(Police) Then Police = .Name
If IsMissing(Taille) Then Taille = .Font.Size
End With
hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
DeleteObject hFont
ReleaseDC 0, hDC
LgTexte = TSize.cx / PixpInch
End Function

Function LgTexteCellule(Cellule As Range)
With Cellule.Font
LgTexteCellule = LgTexte(Cellule.Text, .Name, .Size, .Bold, .Italic)
End With
End Function

Sub Test()
Dim Cell As Range
Application.ScreenUpdating = False
Worksheets.Add
Range("B1") = "Longueur (points)"
Range("B1").Font.Bold = True
With Range("A2:A15")
.Value = "Zaza Excelle dans l'art de miouquer."
.Font.Name = "Times New Roman"
End With
For Each Cell In Range("A2:A15")
Cell.Font.Size = Cell.Row + 6
Cell(1, 2) = LgTexteCellule(Cell)
Next Cell
Range("A:B").EntireColumn.AutoFit
End Sub
'================================================= >>
La fonction LgTexte(Texte, Police, Taille, Gras , Italique) renvoie la
longueur en points du texte transmis, selon les paramètres de police,
taille et format (Gras et Italique: True / False). Par défaut, elle
prend la police standard d'Excel et sa taille, caractères normaux non
italiques.

La fonction LgTexteCellule(Cellule) renvoie la longueur en points du
texte de la cellule en fonction de sa police et de son format. Celui-ci
doit évidemment être uniforme (tous les caractères dans le même format,
la même taille et la même police).

Pour comparer la valeur renvoyée à la largeur d'une colonne, utiliser la
propriété Width de la colonne ou de l'une de ses cellules:
Range("A1").Width.

J 'ai constaté que ma fonction appliquée sur une cellule (par exemple A1)
renvoie une valeur très légèrement inférieure à Range("A1").Width quand
la largeur de la colonne est ajustée au texte de A1, Excel rajoutant
automatiquement une légère marge à gauche et à droite des cellules. Je
ne sais pas comment calculer cette marge. La différence est d'environ
+1-2% par rapport à la longueur renvoyée par LgTexteCellule avec les
polices de taille usuelle (entre 8 et 14 points). En-dessous, elle peut
être un peu plus importante.

En espérant que ce te soit utile...

Laurent
-----------------------------------------------------------------------------------------
isabelle

Bonjour,

Je teste cela dans la journée.

Merci pour ton aide.

--
lSteph

isabelle a écrit :

et celui-ci de notre grand chef à quatre plumes,
------------------------------------------------------------------------------------------------------------

'Laurent Longre
'Date : 1999/11/30
'Objet : Re: Q: longueur en pixel ou en points d'un texte
'================================================= >
Type Size
cx As Long
cy As Long
End Type

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Function LgTexte(Texte As String, Optional Police, _
Optional Taille, Optional Gras As Boolean, _
Optional Italique As Boolean)
Dim hFont As Long
Dim hDC As Long
Dim TSize As Size
Dim PixpInch As Double
With ActiveWorkbook.Styles("Normal").Font
If IsMissing(Police) Then Police = .Name
If IsMissing(Taille) Then Taille = .Font.Size
End With
hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
DeleteObject hFont
ReleaseDC 0, hDC
LgTexte = TSize.cx / PixpInch
End Function

Function LgTexteCellule(Cellule As Range)
With Cellule.Font
LgTexteCellule = LgTexte(Cellule.Text, .Name, .Size, .Bold, .Italic)
End With
End Function

Sub Test()
Dim Cell As Range
Application.ScreenUpdating = False
Worksheets.Add
Range("B1") = "Longueur (points)"
Range("B1").Font.Bold = True
With Range("A2:A15")
.Value = "Zaza Excelle dans l'art de miouquer."
.Font.Name = "Times New Roman"
End With
For Each Cell In Range("A2:A15")
Cell.Font.Size = Cell.Row + 6
Cell(1, 2) = LgTexteCellule(Cell)
Next Cell
Range("A:B").EntireColumn.AutoFit
End Sub
'================================================= >
La fonction LgTexte(Texte, Police, Taille, Gras , Italique) renvoie la
longueur en points du texte transmis, selon les paramètres de police,
taille et format (Gras et Italique: True / False). Par défaut, elle
prend la police standard d'Excel et sa taille, caractères normaux non
italiques.

La fonction LgTexteCellule(Cellule) renvoie la longueur en points du
texte de la cellule en fonction de sa police et de son format. Celui-ci
doit évidemment être uniforme (tous les caractères dans le même format,
la même taille et la même police).

Pour comparer la valeur renvoyée à la largeur d'une colonne, utiliser la
propriété Width de la colonne ou de l'une de ses cellules:
Range("A1").Width.

J 'ai constaté que ma fonction appliquée sur une cellule (par exemple A1)
renvoie une valeur très légèrement inférieure à Range("A1").Width quand
la largeur de la colonne est ajustée au texte de A1, Excel rajoutant
automatiquement une légère marge à gauche et à droite des cellules. Je
ne sais pas comment calculer cette marge. La différence est d'environ
+1-2% par rapport à la longueur renvoyée par LgTexteCellule avec les
polices de taille usuelle (entre 8 et 14 points). En-dessous, elle peut
être un peu plus importante.

En espérant que ce te soit utile...

Laurent
-----------------------------------------------------------------------------------------

isabelle

Bonjour,

C'est à peu près ce que j'ai déjà fait (hors evennementiel) mais pour
les textes un peu long cela n'est pas opérant.
L'idée donnée par ailleurs pour compter les retours forcés (chr(10)
combinée,
au calcul nbchr / largeur auquel je vais les ajouter
devrait me donner le nb lignes à multiplier par la hauteur standard
selon la taille de la police.
Puisque LL a déjà expertisé et mis au point une solution, je la
testerai dans la journée .

Je vous tiens au courant.

Merci à tous les deux.

--
lSteph

Essart a écrit :

Bonjour,

Peux-tu essayer cette procédure qui me semble fonctionner à souhaits sous
2003 (pas testée sur les autres ...)

-> en supposant que les commentaires sont en colonne A (à adapter sinon) :

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Columns("A:A")) Is Nothing And Target.Count = 1
Then
With Columns("A:A")
.ColumnWidth = 200
'largeur nécessairement surdimensionnée par rapport à ce que
plausible
.AutoFit
End With
With Target.Rows
.RowHeight = 200 ' bis repetita
.AutoFit
End With
Target.Select
End If
End Sub

J'ai testé et cela marche ; si c'est bien ce que tu recherches ... ?

Qu'en penses-tu ?

Essart


"isabelle" <i@v> a écrit dans le message de news:
ekWJ3szNKHA.4964@TK2MSFTNGP06.phx.gbl...

et celui-ci de notre grand chef à quatre plumes,
------------------------------------------------------------------------------------------------------------
'Laurent Longre
'Date : 1999/11/30
'Objet : Re: Q: longueur en pixel ou en points d'un texte
'================================================= >>
Type Size
cx As Long
cy As Long
End Type

Declare Function GetDC Lib "user32" (ByVal hwnd As Long) As Long

Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hDC As Long) As Long

Declare Function CreateFontA Lib "gdi32" _
(ByVal H As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long

Declare Function SelectObject Lib "gdi32" _
(ByVal hDC As Long, ByVal hObject As Long) As Long

Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long

Declare Function GetTextExtentPoint32A Lib "gdi32" _
(ByVal hDC As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As Size) As Long

Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hDC As Long, ByVal nIndex As Long) As Long

Function LgTexte(Texte As String, Optional Police, _
Optional Taille, Optional Gras As Boolean, _
Optional Italique As Boolean)
Dim hFont As Long
Dim hDC As Long
Dim TSize As Size
Dim PixpInch As Double
With ActiveWorkbook.Styles("Normal").Font
If IsMissing(Police) Then Police = .Name
If IsMissing(Taille) Then Taille = .Font.Size
End With
hDC = GetDC(0)
PixpInch = GetDeviceCaps(hDC, 90) / 72
hFont = CreateFontA(-Taille * PixpInch, 0, 0, 0, _
400 + 300 * Gras, Italique, 0, 0, 1, 0, 0, 0, 0, Police)
If hFont = 0 Then LgTexte = CVErr(xlErrValue): Exit Function
SelectObject hDC, hFont
GetTextExtentPoint32A hDC, Texte, Len(Texte), TSize
DeleteObject hFont
ReleaseDC 0, hDC
LgTexte = TSize.cx / PixpInch
End Function

Function LgTexteCellule(Cellule As Range)
With Cellule.Font
LgTexteCellule = LgTexte(Cellule.Text, .Name, .Size, .Bold, .Italic)
End With
End Function

Sub Test()
Dim Cell As Range
Application.ScreenUpdating = False
Worksheets.Add
Range("B1") = "Longueur (points)"
Range("B1").Font.Bold = True
With Range("A2:A15")
.Value = "Zaza Excelle dans l'art de miouquer."
.Font.Name = "Times New Roman"
End With
For Each Cell In Range("A2:A15")
Cell.Font.Size = Cell.Row + 6
Cell(1, 2) = LgTexteCellule(Cell)
Next Cell
Range("A:B").EntireColumn.AutoFit
End Sub
'================================================= >>
La fonction LgTexte(Texte, Police, Taille, Gras , Italique) renvoie la
longueur en points du texte transmis, selon les paramètres de police,
taille et format (Gras et Italique: True / False). Par défaut, elle
prend la police standard d'Excel et sa taille, caractères normaux non
italiques.

La fonction LgTexteCellule(Cellule) renvoie la longueur en points du
texte de la cellule en fonction de sa police et de son format. Celui-ci
doit évidemment être uniforme (tous les caractères dans le même format,
la même taille et la même police).

Pour comparer la valeur renvoyée à la largeur d'une colonne, utiliser la
propriété Width de la colonne ou de l'une de ses cellules:
Range("A1").Width.

J 'ai constaté que ma fonction appliquée sur une cellule (par exemple A1)
renvoie une valeur très légèrement inférieure à Range("A1").Width quand
la largeur de la colonne est ajustée au texte de A1, Excel rajoutant
automatiquement une légère marge à gauche et à droite des cellules. Je
ne sais pas comment calculer cette marge. La différence est d'environ
+1-2% par rapport à la longueur renvoyée par LgTexteCellule avec les
polices de taille usuelle (entre 8 et 14 points). En-dessous, elle peut
être un peu plus importante.

En espérant que ce te soit utile...

Laurent
-----------------------------------------------------------------------------------------
isabelle