L'informatique à votre portée
L'informatique prêt-à-porter

Faites appel à moi pour vos formations
sur les dpts 81, 31, 82, 11 et 67 (Strasbourg)
Confiez moi vos développements Office

FacebookTwitterGoogle BookmarksLinkedin

Largeur de colonne et hauteur de ligne en centimètres

Imprimer E-mail
5 mars 2014
Sub ColonnesEnCentimetres()
     Dim iCm As Integer, iPoints As Integer, iOldLargeur As Integer
     Dim iNb As Integer, iMax As Integer, iCurr As Integer, iMin As Integer
     iCm = Application.InputBox("Entrer la largeur de la colonne en iCms", "Largeur de la colonne souhaitée")
     If iCm = False Then Exit Sub
     iPoints = Application.CentimetersToPoints(iCm)
     iOldLargeur = ActiveCell.ColumnWidth
     'la largeur d'une colonne se fait en fonction de la largeur des caractères
     ' on simule donc la largeur avec 255 caractères
     iMin = 0
     iMax = 255
     ActiveCell.ColumnWidth = iMax
     If iPoints > ActiveCell.Width Then
          MsgBox "la largeur de" & iCm & "est trop large" & Chr(10) & "la valeur maxi est de " & _
               Format(ActiveCell.Width / 28.3464566929134, "0.00"), vbOKOnly + vbExclamation, "largeur non valable"
          ActiveCell.ColumnWidth = iOldLargeur
          Exit Sub
     End If
     'maintenant on recherche par approximation la largeur la plus proche de celle demandée     ' en divisant par 2 à chaque boucle 
     ActiveCell.ColumnWidth = 127.5
     iCurr = ActiveCell.ColumnWidth
     iNb = 0
     Do While (ActiveCell.Width <> iPoints) And (iNb < 20)
          If ActiveCell.Width < iPoints Then
               iMin = iCurr
               Selection.ColumnWidth = (iCurr + iMax) / 2
          Else
               iMax = iCurr
               Selection.ColumnWidth = (iCurr + iMin) / 2
          End If
          iCurr = ActiveCell.ColumnWidth
          iNb = iNb + 1
     Loop
End Sub
Sub LignesEnCentimetres()
     Dim iCm As Integer
     'pour la hauteur des lignes c'est plus simple il suffit de convertir des points en centimètres
     iCm = Application.InputBox("Entrer la hauteur de la ligne en centimetres", "Hauteur de la ligne souhaitée")
     If iCm Then Selection.RowHeight = Application.CentimetersToPoints(cm)
End Sub