largeur et hauteur d'une cellule

Bonjour Nicolas

Deux macros parues il y a très longtemps sur ce forum et que je te livre
toutes brutes :
Je n'en connais plus l'auteur et je m'excuse de ne pouvoir le nommer.
Largeur de colonnes et hauteur de lignes en centimètres


Sub RowHeightInCentimeters()

Dim cm As Integer

' Get the row height in centimeters.

cm = Application.InputBox("Enter Row Height in Centimeters", _

"Row Height (cm)", Type:=1)

' If cancel button not pressed and a value entered.

If cm Then

' Convert and set the row height

Selection.RowHeight = Application.CentimetersToPoints(cm)

End If

End Sub



Sub ColumnWidthInCentimeters()

Dim cm As Integer, points As Integer, savewidth As Integer

Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer

Dim Count As Integer

' Turn screen updating off.

Application.ScreenUpdating = False

' Ask for the width in inches wanted.

cm = Application.InputBox("Enter Column Width in Centimeters", _

"Column Width (cm)", Type:=1)

' If cancel button for the input box was pressed, exit procedure.

If cm = False Then Exit Sub

' Convert the inches entered to points.

Points = Application.CentimetersToPoints(cm)

' Save the current column width setting.

savewidth = ActiveCell.ColumnWidth

' Set the column width to the maximum allowed.

ActiveCell.ColumnWidth = 255

' If the points desired is greater than the points for 255

' characters...

If Points > ActiveCell.Width Then

' Display a message box because the size specified is too

' large and give the maximum allowed value.

MsgBox "Width of " & cm & " is too large." & Chr(10) & _

"The maximum value is " & _

Format(ActiveCell.Width / 28.3464566929134, _

"0.00"), vbOKOnly + vbExclamation, "Width Error"

' Reset the column width back to the original.

ActiveCell.ColumnWidth = savewidth

' Exit the Sub.

Exit Sub

End If

' Set the lowerwidth and upper width variables.

lowerwidth = 0

upwidth = 255

' Set the column width to the middle of the allowed character

' range.

ActiveCell.ColumnWidth = 127.5

curwidth = ActiveCell.ColumnWidth

' Set the count to 0 so if it can't find an exact match it won't

' go on indefinitely.

Count = 0

' Loop as long as the cell width in is different from width

' wanted and the count (iterations) of the loop is less than 20.

While (ActiveCell.Width <> Points) And (Count < 20)

' If active cell width is less than desired cell width.

If ActiveCell.Width < Points Then

' Reset lower width to current width.

lowerwidth = curwidth

' set current column width to the midpoint of curwidth

' and upwidth.

Selection.ColumnWidth = (curwidth + upwidth) / 2

' If active cell width is greater than desired cell width.

Else

' Set upwidth to the curwidth.

upwidth = curwidth

' Set column width to the mid point of curwidth and lower

' width.

Selection.ColumnWidth = (curwidth + lowerwidth) / 2

End If

' Set curwidth to the width of the column now.

curwidth = ActiveCell.ColumnWidth

' Increment the count counter.

Count = Count + 1

Wend

End Sub



--
salut ! ;o)
Michel
******** Enlever '_nospam' pour me répondre ********



BISOUX nicolas wrote:

bonjour,
Je dois avoir à l'impression une cellule dont les dimensions sont en
mm ou cm. Or sur excel je peux définir la hauteur en points et la
largeur en ????. Comment puis je obtenir une dimension de cellule en
cm ou mm.
D'avance merci pour votre aide.

je crois bien, michel, que l'auteur n'est autre que bilou...
jps

michelB wrote:

Bonjour Nicolas

Deux macros parues il y a très longtemps sur ce forum et que je te livre
toutes brutes :
Je n'en connais plus l'auteur et je m'excuse de ne pouvoir le nommer.
Largeur de colonnes et hauteur de lignes en centimètres

Sub RowHeightInCentimeters()

Dim cm As Integer

' Get the row height in centimeters.

cm = Application.InputBox("Enter Row Height in Centimeters", _

"Row Height (cm)", Type:=1)

' If cancel button not pressed and a value entered.

If cm Then

' Convert and set the row height

Selection.RowHeight = Application.CentimetersToPoints(cm)

End If

End Sub

Sub ColumnWidthInCentimeters()

Dim cm As Integer, points As Integer, savewidth As Integer

Dim lowerwidth As Integer, upwidth As Integer, curwidth As Integer

Dim Count As Integer

' Turn screen updating off.

Application.ScreenUpdating = False

' Ask for the width in inches wanted.

cm = Application.InputBox("Enter Column Width in Centimeters", _

"Column Width (cm)", Type:=1)

' If cancel button for the input box was pressed, exit procedure.

If cm = False Then Exit Sub

' Convert the inches entered to points.

Points = Application.CentimetersToPoints(cm)

' Save the current column width setting.

savewidth = ActiveCell.ColumnWidth

' Set the column width to the maximum allowed.

ActiveCell.ColumnWidth = 255

' If the points desired is greater than the points for 255

' characters...

If Points > ActiveCell.Width Then

' Display a message box because the size specified is too

' large and give the maximum allowed value.

MsgBox "Width of " & cm & " is too large." & Chr(10) & _

"The maximum value is " & _

Format(ActiveCell.Width / 28.3464566929134, _

"0.00"), vbOKOnly + vbExclamation, "Width Error"

' Reset the column width back to the original.

ActiveCell.ColumnWidth = savewidth

' Exit the Sub.

Exit Sub

End If

' Set the lowerwidth and upper width variables.

lowerwidth = 0

upwidth = 255

' Set the column width to the middle of the allowed character

' range.

ActiveCell.ColumnWidth = 127.5

curwidth = ActiveCell.ColumnWidth

' Set the count to 0 so if it can't find an exact match it won't

' go on indefinitely.

Count = 0

' Loop as long as the cell width in is different from width

' wanted and the count (iterations) of the loop is less than 20.

While (ActiveCell.Width <> Points) And (Count < 20)

' If active cell width is less than desired cell width.

If ActiveCell.Width < Points Then

' Reset lower width to current width.

lowerwidth = curwidth

' set current column width to the midpoint of curwidth

' and upwidth.

Selection.ColumnWidth = (curwidth + upwidth) / 2

' If active cell width is greater than desired cell width.

Else

' Set upwidth to the curwidth.

upwidth = curwidth

' Set column width to the mid point of curwidth and lower

' width.

Selection.ColumnWidth = (curwidth + lowerwidth) / 2

End If

' Set curwidth to the width of the column now.

curwidth = ActiveCell.ColumnWidth

' Increment the count counter.

Count = Count + 1

Wend

End Sub

--
salut ! ;o)
Michel
******** Enlever '_nospam' pour me répondre ********

BISOUX nicolas wrote:

bonjour,
Je dois avoir à l'impression une cellule dont les dimensions sont en
mm ou cm. Or sur excel je peux définir la hauteur en points et la
largeur en ????. Comment puis je obtenir une dimension de cellule en
cm ou mm.
D'avance merci pour votre aide.

Merci beaucoup michelB,
C'est la première fois que je poste une demande et je ne m'attendais
vraiment pas à une réponse aussi rapide.
Encore une fois merci pour votre aide.