Zoomer sur la cellule active pour en voir le contenu

Page créée le: 23/11/2009

      Il arrive parfois que pour des raisons d'affichage, vous soyez obligé de régler le zoom de votre
feuille à 75%, voire 50% et dans ce cas si pour voir le contenu d'une cellule cela devient diffilement lisible.
Vous pouvez bien entendu remettre le zoom à 100% mais cela peut devenir fastidieux car il vous
faudra à chaque modifier le zoom de votre feuille.

Voici deux méthodes (trouvées sur le site Microsoft Excel Tips - Excel.Tips.Net)
       1-Zoom sur la cellule active avec une procédure événementielle
       2-Zoom sur la cellule active avec une macro associée à des touches de raccourci

Exemple: Zoom sur la cellule active avec une macro associée à des touches de raccourci.
     CTRL+a pour zoomer la cellule active
     CTRL+q pour annuler le zoom de la cellule

Le code VBA:
      Pour que cette procédure fonctionne, il faut mettre le code VBA dans un module standard.
      Ne pas oublier d'associer les touches de raccourci.
     

Sub Zoom()

   ' Touche de raccourci: CTRL+a

   Dim s As Range

   Dim ZoomIn As Single

   Set s = Selection

   ZoomIn = 6

   ' Efface le zoom actuellement actif

   For Each p In ActiveSheet.Pictures

      If p.Name = "ZoomCell" Then

         p.Delete

         Exit For

      End If

   Next

   'Copier la cellule dans une image, coller

   ' cette image et l'agrandir

   s.CopyPicture Appearance:=xlScreen, Format :=xlPicture

   ActiveSheet.Pictures.Paste.Select

   With Selection

      .Name = "ZoomCell"

      With .ShapeRange

         .ScaleWidth ZoomIn, msoFalse, msoScaleFromTopLeft

         .ScaleHeight ZoomIn, msoFalse, msoScaleFromTopLeft

         With .Fill

            .ForeColor.SchemeColor = 9

            .Visible = msoTrue

            .Solid

         End With

      End With

   End With

   s.Select

   Set s = Nothing

End Sub


Sub EffaceShape()

   ' Touche de raccourci: CTRL+q

   ' Permet de mettre fin au processus de zoom

   ActiveSheet.Shapes( "ZoomCell" ).Delete

End Sub