Function DimensionCellule(ByVal x As Long, ByVal y As Long)
'Auteur : JPV
Dim h%, Point&, rng&, rng1&
Dim hauteur&, largeur&, rapport&
Cells(x, y).Select
h = 8 'dimension en millimètre
Point = h / 0.35
With Selection
.RowHeight = Point
End With
'------ asservissement pour avoir les cellules carrées ------
Do
rng = ActiveCell.Width
rng1 = ActiveCell.Height
hauteur = ActiveCell.RowHeight
largeur = ActiveCell.ColumnWidth
rapport = rng / rng1
With Selection
.RowHeight = hauteur
.ColumnWidth = largeur / rapport
End With
Loop Until rapport = 1
End Function
'===============================
Sub CelluleCarré() 'Manip Test
Dim i%
Sheets("Feuil1").Select
Application.ScreenUpdating = False
For i = 1 To 9
DimensionCellule i, i
Next i
Application.ScreenUpdating = True
Cells(1, 1).Select
End Sub
'================================