Je vais tenter d'être clair et précis, ce qui va forcément être un peu
long.
Je suis en train de finaliser un document "un peu compliqué" (pour moi
au moins) avec pas mal de macros. Parmi ces macros, certaines
construisent des tableaux dans le document. Les macros fixent les
dimensions du tableau ( hauteur des lignes et largeur des cellules).
Les cellules sont prévues pour recevoir du texte de taille assez
variable... Mais c'est prévu pour occuper une seule ligne. Cependant,
Il arrive qu'avec la police et la taille fixée au départ, un retour de
ligne augmente la hauteur d'un ligne ce qui met en l'air la mise en
page... Je pourrais choisir un police plus petite pour que cela ne se
produise pas mais ces cas là sont rares et le reste du temps, la
police est "bien adaptée"...
Je pensais que la propriété FitText d'une cellule conviendrait mais
lorsque le texte est cours, il est étiré pour remplir la cellule en
largeur et c'est particulièrement moche.
J'ai donc fait une Sub qui ne met FitText que si "nécessaire" ... la
vérification est pour le moment basée sur le nb de caractères mais ce
paramètre n'est pas très pertinent puisque les caractères sont de
largeur variable. Je suis donc obligé de minorer assez grossièrement
pour que le pb ne se produise pas...
Au départ je pensais tester la hauteur de la ligne pour repérer les pb
mais j'ai constaté que la propriété Height n'est pas impactée par le
changement de hauteur lorsque le texte est "trop long"... de plus cela
ne me dirait pas quelle cellule est à l'origine du changement.
donc ... voilà ma question ?
Comment connaitre concrètement le nombre réel de lignes d'une cellule
?
ou alors
comment détecter la présence d'un saut de ligne dans une cellule ?
Merci d'avance pour vos lumières,
bien cordialement,
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Je vais tenter d'être clair et précis, ce qui va forcément être un peu long.
Je suis en train de finaliser un document "un peu compliqué" (pour moi au moins) avec pas mal de macros. Parmi ces macros, certaines construisent des tableaux dans le document. Les macros fixent les dimensions du tableau ( hauteur des lignes et largeur des cellules). Les cellules sont prévues pour recevoir du texte de taille assez variable... Mais c'est prévu pour occuper une seule ligne. Cependant, Il arrive qu'avec la police et la taille fixée au départ, un retour de ligne augmente la hauteur d'un ligne ce qui met en l'air la mise en page... Je pourrais choisir un police plus petite pour que cela ne se produise pas mais ces cas là sont rares et le reste du temps, la police est "bien adaptée"...
Je pensais que la propriété FitText d'une cellule conviendrait mais lorsque le texte est cours, il est étiré pour remplir la cellule en largeur et c'est particulièrement moche.
Vous pouvez essayer le vieil astuce qui consiste à ajouter un caractère de tabulation (VbTab) en fin de texte de chaque cellule. En espérant que ça ne gêne pas autre chose.
-- A+
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]
Je vais tenter d'être clair et précis, ce qui va forcément être un peu long.
Je suis en train de finaliser un document "un peu compliqué" (pour moi au moins) avec
pas mal de macros. Parmi ces macros, certaines construisent des tableaux dans le
document. Les macros fixent les dimensions du tableau ( hauteur des lignes et largeur
des cellules). Les cellules sont prévues pour recevoir du texte de taille assez
variable... Mais c'est prévu pour occuper une seule ligne. Cependant, Il arrive qu'avec
la police et la taille fixée au départ, un retour de ligne augmente la hauteur d'un
ligne ce qui met en l'air la mise en page... Je pourrais choisir un police plus petite
pour que cela ne se produise pas mais ces cas là sont rares et le reste du temps, la
police est "bien adaptée"...
Je pensais que la propriété FitText d'une cellule conviendrait mais lorsque le texte
est cours, il est étiré pour remplir la cellule en largeur et c'est particulièrement
moche.
Vous pouvez essayer le vieil astuce qui consiste à ajouter un caractère
de tabulation (VbTab) en fin de texte de chaque cellule.
En espérant que ça ne gêne pas autre chose.
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Je vais tenter d'être clair et précis, ce qui va forcément être un peu long.
Je suis en train de finaliser un document "un peu compliqué" (pour moi au moins) avec pas mal de macros. Parmi ces macros, certaines construisent des tableaux dans le document. Les macros fixent les dimensions du tableau ( hauteur des lignes et largeur des cellules). Les cellules sont prévues pour recevoir du texte de taille assez variable... Mais c'est prévu pour occuper une seule ligne. Cependant, Il arrive qu'avec la police et la taille fixée au départ, un retour de ligne augmente la hauteur d'un ligne ce qui met en l'air la mise en page... Je pourrais choisir un police plus petite pour que cela ne se produise pas mais ces cas là sont rares et le reste du temps, la police est "bien adaptée"...
Je pensais que la propriété FitText d'une cellule conviendrait mais lorsque le texte est cours, il est étiré pour remplir la cellule en largeur et c'est particulièrement moche.
Vous pouvez essayer le vieil astuce qui consiste à ajouter un caractère de tabulation (VbTab) en fin de texte de chaque cellule. En espérant que ça ne gêne pas autre chose.
-- A+
Lotre
Bonsoir,
Geo wrote: (...)
Vous pouvez essayer le vieil astuce qui consiste à ajouter un caractère de tabulation (VbTab) en fin de texte de chaque cellule. En espérant que ça ne gêne pas autre chose.
Merci de te pencher sur cette affaire.
Je viens de tester et si je ne m'abuse cela ne supprime pas l'étirement d'un texte cours... (à moins peut-être de définir une tabulation unique particulière sur le paragraphe associé ... je n'ai pas testé ça...)
Quoi qu'il en soit cette "astuce" ne répond pas aux questions posées en fin de message...
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA combien de lignes utilisent concrètement le contenu d'une cellule...
A+
Cordialement,
HB
Bonsoir,
Geo wrote:
(...)
Vous pouvez essayer le vieil astuce qui consiste à ajouter un
caractère de tabulation (VbTab) en fin de texte de chaque cellule.
En espérant que ça ne gêne pas autre chose.
Merci de te pencher sur cette affaire.
Je viens de tester et si je ne m'abuse cela ne supprime pas
l'étirement d'un texte cours... (à moins peut-être de définir une
tabulation unique particulière sur le paragraphe associé ... je n'ai
pas testé ça...)
Quoi qu'il en soit cette "astuce" ne répond pas aux questions posées
en fin de message...
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA
combien de lignes utilisent concrètement le contenu d'une cellule...
Vous pouvez essayer le vieil astuce qui consiste à ajouter un caractère de tabulation (VbTab) en fin de texte de chaque cellule. En espérant que ça ne gêne pas autre chose.
Merci de te pencher sur cette affaire.
Je viens de tester et si je ne m'abuse cela ne supprime pas l'étirement d'un texte cours... (à moins peut-être de définir une tabulation unique particulière sur le paragraphe associé ... je n'ai pas testé ça...)
Quoi qu'il en soit cette "astuce" ne répond pas aux questions posées en fin de message...
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA combien de lignes utilisent concrètement le contenu d'une cellule...
A+
Cordialement,
HB
Geo
Bonjour
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Je viens de tester et si je ne m'abuse cela ne supprime pas l'étirement d'un texte cours...
J'ai essayé à la main, ça a marché. Il faudrait que je le fasse en vba, ce sera pour demain ....
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA combien de lignes utilisent concrètement le contenu d'une cellule...
Si sans doute, peut-être en utilisant la position du point d'insertion (Application.informations) mais vu que la première solution avait l'air de marcher, je n'ai pas cherché.
-- A+
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]
Je viens de tester et si je ne m'abuse cela ne supprime pas l'étirement d'un texte
cours...
J'ai essayé à la main, ça a marché.
Il faudrait que je le fasse en vba, ce sera pour demain ....
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA combien de lignes
utilisent concrètement le contenu d'une cellule...
Si sans doute, peut-être en utilisant la position du point d'insertion
(Application.informations) mais vu que la première solution avait l'air
de marcher, je n'ai pas cherché.
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Je viens de tester et si je ne m'abuse cela ne supprime pas l'étirement d'un texte cours...
J'ai essayé à la main, ça a marché. Il faudrait que je le fasse en vba, ce sera pour demain ....
C'est tout de même bizarre que l'on ne puisse pas savoir via VBA combien de lignes utilisent concrètement le contenu d'une cellule...
Si sans doute, peut-être en utilisant la position du point d'insertion (Application.informations) mais vu que la première solution avait l'air de marcher, je n'ai pas cherché.
-- A+
Geo
Bonjour
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Toujours pour le FitText, voici une macro qui ajoute le vbTab au bon endroit, c'est probablement pour une raison d'emplacement que ça n'a pas marché chez vous.
Sub Ajuster() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Set Doc = ActiveDocument Debug.Print Doc.name 'Premier tableau Set MaTable = ActiveDocument.Tables(1) For Each Cellule In MaTable.Range.Cells TexteO = Cellule.Range.Text 'Troncature des caractères non imprimables à la fin du texte original While Asc(Right(TexteO, 1)) < Asc("!") TexteO = Left(TexteO, Len(TexteO) - 1) Wend Cellule.Range.Text = TexteO & vbTab Cellule.FitText = True Next End Sub
La macro est écrite de manière à donner un résultat correct même si vous la passez plusieurs fois. Par contre le résultat n'est pas toujours bon si vous avec plusieurs paragraphes dans la même cellule, les premiers sont ajustés comme cela vous est arrivé. Ça peut évidemment être complété.
La fin de ligne est tronquée dans certains cas, mais à la main aussi, je ne sais pas pourquoi.
-- A+
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]
Toujours pour le FitText, voici une macro qui ajoute le vbTab au bon
endroit, c'est probablement pour une raison d'emplacement que ça n'a
pas marché chez vous.
Sub Ajuster()
Dim Doc As Document
Dim MaTable As Table
Dim Cellule As Cell
Dim TexteO As String
Set Doc = ActiveDocument
Debug.Print Doc.name
'Premier tableau
Set MaTable = ActiveDocument.Tables(1)
For Each Cellule In MaTable.Range.Cells
TexteO = Cellule.Range.Text
'Troncature des caractères non imprimables à la fin du texte original
While Asc(Right(TexteO, 1)) < Asc("!")
TexteO = Left(TexteO, Len(TexteO) - 1)
Wend
Cellule.Range.Text = TexteO & vbTab
Cellule.FitText = True
Next
End Sub
La macro est écrite de manière à donner un résultat correct même si
vous la passez plusieurs fois.
Par contre le résultat n'est pas toujours bon si vous avec plusieurs
paragraphes dans la même cellule, les premiers sont ajustés comme cela
vous est arrivé. Ça peut évidemment être complété.
La fin de ligne est tronquée dans certains cas, mais à la main aussi,
je ne sais pas pourquoi.
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Toujours pour le FitText, voici une macro qui ajoute le vbTab au bon endroit, c'est probablement pour une raison d'emplacement que ça n'a pas marché chez vous.
Sub Ajuster() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Set Doc = ActiveDocument Debug.Print Doc.name 'Premier tableau Set MaTable = ActiveDocument.Tables(1) For Each Cellule In MaTable.Range.Cells TexteO = Cellule.Range.Text 'Troncature des caractères non imprimables à la fin du texte original While Asc(Right(TexteO, 1)) < Asc("!") TexteO = Left(TexteO, Len(TexteO) - 1) Wend Cellule.Range.Text = TexteO & vbTab Cellule.FitText = True Next End Sub
La macro est écrite de manière à donner un résultat correct même si vous la passez plusieurs fois. Par contre le résultat n'est pas toujours bon si vous avec plusieurs paragraphes dans la même cellule, les premiers sont ajustés comme cela vous est arrivé. Ça peut évidemment être complété.
La fin de ligne est tronquée dans certains cas, mais à la main aussi, je ne sais pas pourquoi.
-- A+
Geo
Re
La macro est écrite de manière à donner un résultat correct même si vous la passez plusieurs fois. Par contre le résultat n'est pas toujours bon si vous avec plusieurs paragraphes dans la même cellule, les premiers sont ajustés comme cela vous est arrivé. Ça peut évidemment être complété.
Ne marche pas non plus si la cellule est vide.
La fin de ligne est tronquée dans certains cas, mais à la main aussi, je ne sais pas pourquoi.
Comme ça fait la même chose avec la bêta 2010, je l'ai signalé. On verra bien.
-- A+
Re
La macro est écrite de manière à donner un résultat correct même si vous la passez
plusieurs fois.
Par contre le résultat n'est pas toujours bon si vous avec plusieurs paragraphes dans
la même cellule, les premiers sont ajustés comme cela vous est arrivé. Ça peut
évidemment être complété.
Ne marche pas non plus si la cellule est vide.
La fin de ligne est tronquée dans certains cas, mais à la main aussi, je ne sais pas
pourquoi.
Comme ça fait la même chose avec la bêta 2010, je l'ai signalé.
On verra bien.
La macro est écrite de manière à donner un résultat correct même si vous la passez plusieurs fois. Par contre le résultat n'est pas toujours bon si vous avec plusieurs paragraphes dans la même cellule, les premiers sont ajustés comme cela vous est arrivé. Ça peut évidemment être complété.
Ne marche pas non plus si la cellule est vide.
La fin de ligne est tronquée dans certains cas, mais à la main aussi, je ne sais pas pourquoi.
Comme ça fait la même chose avec la bêta 2010, je l'ai signalé. On verra bien.
-- A+
Lotre
bonjour,
Geo wrote:
Sub Ajuster() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Set Doc = ActiveDocument Debug.Print Doc.name 'Premier tableau Set MaTable = ActiveDocument.Tables(1) For Each Cellule In MaTable.Range.Cells TexteO = Cellule.Range.Text 'Troncature des caractères non imprimables à la fin du texte original While Asc(Right(TexteO, 1)) < Asc("!") TexteO = Left(TexteO, Len(TexteO) - 1) Wend Cellule.Range.Text = TexteO & vbTab Cellule.FitText = True Next End Sub
je vais tester ça mais en l'adaptant :
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext après avoir mis ce qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette affaire.
Je me méfie des manipulations sur range.text car certaines cellules utilisent des caractères spéciaux ajoutés avec Selection.InsertSymbol Font:="Symbol", ... etc. ... et asc() ne retourne alors rien d'utile ...
pour finir : Un truc bizarre :
Si une cellule contient "concrètement" n caractères
Sub Ajuster()
Dim Doc As Document
Dim MaTable As Table
Dim Cellule As Cell
Dim TexteO As String
Set Doc = ActiveDocument
Debug.Print Doc.name
'Premier tableau
Set MaTable = ActiveDocument.Tables(1)
For Each Cellule In MaTable.Range.Cells
TexteO = Cellule.Range.Text
'Troncature des caractères non imprimables à la fin du texte
original
While Asc(Right(TexteO, 1)) < Asc("!")
TexteO = Left(TexteO, Len(TexteO) - 1)
Wend
Cellule.Range.Text = TexteO & vbTab
Cellule.FitText = True
Next
End Sub
je vais tester ça mais en l'adaptant :
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext
après avoir mis ce qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une
ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette
affaire.
Je me méfie des manipulations sur range.text car certaines cellules
utilisent des caractères spéciaux ajoutés avec
Selection.InsertSymbol Font:="Symbol", ... etc. ...
et asc() ne retourne alors rien d'utile ...
pour finir :
Un truc bizarre :
Si une cellule contient "concrètement" n caractères
Sub Ajuster() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Set Doc = ActiveDocument Debug.Print Doc.name 'Premier tableau Set MaTable = ActiveDocument.Tables(1) For Each Cellule In MaTable.Range.Cells TexteO = Cellule.Range.Text 'Troncature des caractères non imprimables à la fin du texte original While Asc(Right(TexteO, 1)) < Asc("!") TexteO = Left(TexteO, Len(TexteO) - 1) Wend Cellule.Range.Text = TexteO & vbTab Cellule.FitText = True Next End Sub
je vais tester ça mais en l'adaptant :
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext après avoir mis ce qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette affaire.
Je me méfie des manipulations sur range.text car certaines cellules utilisent des caractères spéciaux ajoutés avec Selection.InsertSymbol Font:="Symbol", ... etc. ... et asc() ne retourne alors rien d'utile ...
pour finir : Un truc bizarre :
Si une cellule contient "concrètement" n caractères
je viens de tester - en ajoutant VbTab à la fin -> c'est la zone complète...
- en utilisant la procédure proposée l'étirement a lieu ...
Je développe et teste avec office2000... Sans doute est-ce là l'os ...
Les utilisateurs auront 2000 ou 2003 (... peut-être un ou deux office2007) je préfère choisir une voie qui marche pour tous...
HB
Geo
Bonjour
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext après avoir mis ce qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette affaire.
D'accord [...]
Si une cellule contient "concrètement" n caractères
len(oRange.text) vaut n+2 oRange.characters.count vaut n+1 avec set oRange = Tablo.Cells(i,j).Range
au départ ça surprend un peu ;o)
La fin de cellule est un caractère qui occupe deux octets ! On ne trouve ça nulle part dans la doc. C'est pour cela que dans la macro, on élimine tous les octets dont la valeur est inférieure à "!" qui est le premier caractère imprimable.
-- A+
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext après avoir mis ce
qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette affaire.
D'accord
[...]
Si une cellule contient "concrètement" n caractères
len(oRange.text) vaut n+2
oRange.characters.count vaut n+1
avec
set oRange = Tablo.Cells(i,j).Range
au départ ça surprend un peu ;o)
La fin de cellule est un caractère qui occupe deux octets !
On ne trouve ça nulle part dans la doc.
C'est pour cela que dans la macro, on élimine tous les octets dont la
valeur est inférieure à "!" qui est le premier caractère imprimable.
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ]
Normalement, il suffit que j'ajoute vbTab avec selection.Typetext après avoir mis ce qui doit aller dans la cellule
Chaque cellule ne contient qu'un paragraphe (et ne doit faire qu'une ligne)
En ajoutant VbTab au moment de l'écriture, je contrôlerais mieux cette affaire.
D'accord [...]
Si une cellule contient "concrètement" n caractères
len(oRange.text) vaut n+2 oRange.characters.count vaut n+1 avec set oRange = Tablo.Cells(i,j).Range
au départ ça surprend un peu ;o)
La fin de cellule est un caractère qui occupe deux octets ! On ne trouve ça nulle part dans la doc. C'est pour cela que dans la macro, on élimine tous les octets dont la valeur est inférieure à "!" qui est le premier caractère imprimable.
-- A+
Geo
Bonjour
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ] re,
je viens de tester - en ajoutant VbTab à la fin -> c'est la zone complète...
- en utilisant la procédure proposée l'étirement a lieu ...
Je développe et teste avec office2000... Sans doute est-ce là l'os ...
Possible, essayez quand même en ajoutant à la main une tabulation (CTL+Tab) pour en avoir la certitude
Les utilisateurs auront 2000 ou 2003 (... peut-être un ou deux office2007) je préfère choisir une voie qui marche pour tous...
Ca tombe bien, je viens de terminer une petite macro qui travaille sur la position du point d'insertion. On tente d'abord de réduire l'espace entre les caractères, puis on réduit la police progressivement jusqu'à 8 points. La macro balaye le document actif et traite tous les tableaux. Un message indique quand le traitement est terminé. Sub Ajuster2() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Dim i As Integer Dim j As Integer Dim PosMin As Long Dim PosMax As Long Dim Pos As Long Set Doc = ActiveDocument Debug.Print Doc.name For i = 1 To Doc.Tables.Count ' Table Set MaTable = ActiveDocument.Tables(i) For j = 1 To MaTable.Rows.Count ' Ligne 'PosMin = 9999999 'PosMax = 0 For Each Cellule In MaTable.Rows(j).Range.Cells ' Cellule Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5 ' Plusieurs lignes ' condensation du texte progressivement jusqu'à 0.5 Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1 Debug.Print Cellule.Range.Font.Spacing PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend ' Si ça ne suffit pas on réduit la taille des caractères jusqu'à 8 While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8 Debug.Print " plusieurs lignes 2 ", Cellule.Range.Font.Size Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend Next Cellule DoEvents Next j ' Ligne suivante DoEvents Next i ' Tableau suivant MsgBox "Terminé" End Sub
A ne passer qu'en mode Page. Espérons que ça marche pour toutes les versions.
-- A+
Bonjour
[ Cette réponse est faite sur le forum public Word :
news://msnews.microsoft.com/microsoft.public.fr.word ]
re,
je viens de tester
- en ajoutant VbTab à la fin
-> c'est la zone complète...
- en utilisant la procédure proposée
l'étirement a lieu ...
Je développe et teste avec office2000...
Sans doute est-ce là l'os ...
Possible, essayez quand même en ajoutant à la main une tabulation
(CTL+Tab) pour en avoir la certitude
Les utilisateurs auront 2000 ou 2003
(... peut-être un ou deux office2007)
je préfère choisir une voie qui marche pour tous...
Ca tombe bien, je viens de terminer une petite macro qui travaille sur
la position du point d'insertion.
On tente d'abord de réduire l'espace entre les caractères, puis on
réduit la police progressivement jusqu'à 8 points.
La macro balaye le document actif et traite tous les tableaux.
Un message indique quand le traitement est terminé.
Sub Ajuster2()
Dim Doc As Document
Dim MaTable As Table
Dim Cellule As Cell
Dim TexteO As String
Dim i As Integer
Dim j As Integer
Dim PosMin As Long
Dim PosMax As Long
Dim Pos As Long
Set Doc = ActiveDocument
Debug.Print Doc.name
For i = 1 To Doc.Tables.Count ' Table
Set MaTable = ActiveDocument.Tables(i)
For j = 1 To MaTable.Rows.Count ' Ligne
'PosMin = 9999999
'PosMax = 0
For Each Cellule In MaTable.Rows(j).Range.Cells ' Cellule
Cellule.Select
PosMin = 9999999
PosMax = 0
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
Selection.EndKey Unit:=wdLine
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5
' Plusieurs lignes
' condensation du texte progressivement jusqu'à 0.5
Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1
Debug.Print Cellule.Range.Font.Spacing
PosMax =
Selection.Information(wdVerticalPositionRelativeToPage)
Wend
' Si ça ne suffit pas on réduit la taille des caractères jusqu'à
8
While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8
Debug.Print " plusieurs lignes 2 ", Cellule.Range.Font.Size
Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5
PosMax =
Selection.Information(wdVerticalPositionRelativeToPage)
Wend
Next Cellule
DoEvents
Next j ' Ligne suivante
DoEvents
Next i ' Tableau suivant
MsgBox "Terminé"
End Sub
A ne passer qu'en mode Page.
Espérons que ça marche pour toutes les versions.
[ Cette réponse est faite sur le forum public Word : news://msnews.microsoft.com/microsoft.public.fr.word ] re,
je viens de tester - en ajoutant VbTab à la fin -> c'est la zone complète...
- en utilisant la procédure proposée l'étirement a lieu ...
Je développe et teste avec office2000... Sans doute est-ce là l'os ...
Possible, essayez quand même en ajoutant à la main une tabulation (CTL+Tab) pour en avoir la certitude
Les utilisateurs auront 2000 ou 2003 (... peut-être un ou deux office2007) je préfère choisir une voie qui marche pour tous...
Ca tombe bien, je viens de terminer une petite macro qui travaille sur la position du point d'insertion. On tente d'abord de réduire l'espace entre les caractères, puis on réduit la police progressivement jusqu'à 8 points. La macro balaye le document actif et traite tous les tableaux. Un message indique quand le traitement est terminé. Sub Ajuster2() Dim Doc As Document Dim MaTable As Table Dim Cellule As Cell Dim TexteO As String Dim i As Integer Dim j As Integer Dim PosMin As Long Dim PosMax As Long Dim Pos As Long Set Doc = ActiveDocument Debug.Print Doc.name For i = 1 To Doc.Tables.Count ' Table Set MaTable = ActiveDocument.Tables(i) For j = 1 To MaTable.Rows.Count ' Ligne 'PosMin = 9999999 'PosMax = 0 For Each Cellule In MaTable.Rows(j).Range.Cells ' Cellule Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5 ' Plusieurs lignes ' condensation du texte progressivement jusqu'à 0.5 Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1 Debug.Print Cellule.Range.Font.Spacing PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend ' Si ça ne suffit pas on réduit la taille des caractères jusqu'à 8 While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8 Debug.Print " plusieurs lignes 2 ", Cellule.Range.Font.Size Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend Next Cellule DoEvents Next j ' Ligne suivante DoEvents Next i ' Tableau suivant MsgBox "Terminé" End Sub
A ne passer qu'en mode Page. Espérons que ça marche pour toutes les versions.
-- A+
Lotre
Bonsoir,
OUI !!! c'est ça l'idée que je cherchais. la position verticale relative par rapport à la page permet de détecter la présence de plusieurs lignes...
j'avoue, c'est la première fois que j'utilise "Information" ... Je me souviendrais, désormais, de son existence !
Donc pour un cellule ====================================================== Sub AJUSTE1(Cellule as cell)
Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5 Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend
While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8 Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend
End Sub ====================================================== qui pourrait devenir : ====================================================== Sub AJUSTE2(Cellule as cell)
Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
If PosMax - PosMin > 1 then Cellule.FitText=True End If
End Sub ====================================================== Mais ajuste1 est plus raffiné ... et visuellement c'est plutôt réussi...
Une question cependant :
Même en points, la position doit être identique sur une même "ligne réelle" non ?
Chaque cellule contient une seule ligne parfois trop longue ... d'où ce fil ;o) Normalement, une cellule ne pourra donc pas être "à cheval" sur deux pages... La fin du contenu d'une cellule est forcément sur la même page et après le début.
J'aurais donc tendance à simplifier en ============Ajuste2bis============= Cellule.Select PosDebut = Selection.Information(wdVerticalPositionRelativeToPage) Selection.EndKey Unit:=wdLine PosFin = Selection.Information(wdVerticalPositionRelativeToPage) If PosFin > PosDebut then Cellule.FitText=True end if ================================ Quel est le problème que je n'envisage pas ?
HB
Bonsoir,
OUI !!! c'est ça l'idée que je cherchais.
la position verticale relative par rapport à la page permet de
détecter la présence de plusieurs lignes...
j'avoue, c'est la première fois que j'utilise "Information" ...
Je me souviendrais, désormais, de son existence !
Donc pour un cellule
====================================================== Sub AJUSTE1(Cellule as cell)
Cellule.Select
PosMin = 9999999
PosMax = 0
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
Selection.EndKey Unit:=wdLine
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5
Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1
PosMax =
Selection.Information(wdVerticalPositionRelativeToPage)
Wend
While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8
Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5
PosMax =
Selection.Information(wdVerticalPositionRelativeToPage)
Wend
End Sub
======================================================
qui pourrait devenir :
====================================================== Sub AJUSTE2(Cellule as cell)
Cellule.Select
PosMin = 9999999
PosMax = 0
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
Selection.EndKey Unit:=wdLine
Pos = Selection.Information(wdVerticalPositionRelativeToPage)
If Pos < PosMin Then PosMin = Pos
If Pos > PosMax Then PosMax = Pos
If PosMax - PosMin > 1 then
Cellule.FitText=True
End If
End Sub
====================================================== Mais ajuste1 est plus raffiné ...
et visuellement c'est plutôt réussi...
Une question cependant :
Même en points, la position doit être identique sur une même "ligne
réelle" non ?
Chaque cellule contient une seule ligne parfois trop longue ... d'où
ce fil ;o)
Normalement, une cellule ne pourra donc pas être "à cheval" sur deux
pages...
La fin du contenu d'une cellule est forcément sur la même page et
après le début.
J'aurais donc tendance à simplifier en
============Ajuste2bis============= Cellule.Select
PosDebut = Selection.Information(wdVerticalPositionRelativeToPage)
Selection.EndKey Unit:=wdLine
PosFin = Selection.Information(wdVerticalPositionRelativeToPage)
If PosFin > PosDebut then
Cellule.FitText=True
end if
================================
Quel est le problème que je n'envisage pas ?
Donc pour un cellule ====================================================== Sub AJUSTE1(Cellule as cell)
Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
While PosMax - PosMin > 1 And Cellule.Range.Font.Spacing > -0.5 Cellule.Range.Font.Spacing = Cellule.Range.Font.Spacing - 0.1 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend
While PosMax - PosMin > 1 And Cellule.Range.Font.Size >= 8 Cellule.Range.Font.Size = Cellule.Range.Font.Size - 0.5 PosMax = Selection.Information(wdVerticalPositionRelativeToPage) Wend
End Sub ====================================================== qui pourrait devenir : ====================================================== Sub AJUSTE2(Cellule as cell)
Cellule.Select PosMin = 9999999 PosMax = 0 Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
Selection.EndKey Unit:=wdLine Pos = Selection.Information(wdVerticalPositionRelativeToPage) If Pos < PosMin Then PosMin = Pos If Pos > PosMax Then PosMax = Pos
If PosMax - PosMin > 1 then Cellule.FitText=True End If
End Sub ====================================================== Mais ajuste1 est plus raffiné ... et visuellement c'est plutôt réussi...
Une question cependant :
Même en points, la position doit être identique sur une même "ligne réelle" non ?
Chaque cellule contient une seule ligne parfois trop longue ... d'où ce fil ;o) Normalement, une cellule ne pourra donc pas être "à cheval" sur deux pages... La fin du contenu d'une cellule est forcément sur la même page et après le début.
J'aurais donc tendance à simplifier en ============Ajuste2bis============= Cellule.Select PosDebut = Selection.Information(wdVerticalPositionRelativeToPage) Selection.EndKey Unit:=wdLine PosFin = Selection.Information(wdVerticalPositionRelativeToPage) If PosFin > PosDebut then Cellule.FitText=True end if ================================ Quel est le problème que je n'envisage pas ?