Zoomer sur une cellule, puis revenir à l'affichage initial

Bonjour le Forum,

J'ai souvent besoin de zoomer sur une cellule (par exemple pour faire une loupe le temps de composer un numéro de téléphone noyé dans une grande liste), puis de revenir à l'affichage initial.

Pour ça, j'ai bidouillé une macro avec l'enregistreur de macros, qui en plus colorie la cellule active le temps du zoom (ci-dessous).

Problèmes :

– la manip est parfois très longue, surtout pour revenir à l'affichage initial

– parfois la cellule zoomée se retrouve hors de l'écran

Si qqn peut m'aider à améliorer mes macros, ce serait cool !

Merci.

Sub Affichage_Zoom_cellule()
    ActiveWorkbook.CustomViews.Add ViewName:="x", PrintSettings:=True, _
        RowColSettings:=True
    With Selection.Interior
        .ColorIndex = 45
        .Pattern = xlSolid
    End With
    ActiveWindow.Zoom = 300
End Sub

Sub Affichage_Zoom_cellule_retour()
    Selection.Interior.ColorIndex = xlNone
    ActiveWorkbook.CustomViews("x").Show
End Sub

Bonjour gloub,

de quel façon votre macro est-elle exécuté ?

y a t'il un bouton ?

si oui, ce bouton est-il placer sur la ou les lignes figées au haut de la feuille (à quel adresse?) ?

si il y a une ou plusieurs ligne figées au haut de la feuille,

est ce qu'on pourrait y affiché/masqué un TexBox ayant une Font appropriée ?

Salut gloub, sabV,

et bêtement comme ceci? A toi de savoir où tu cliques!

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
If Target.Count > 1 Or Target = "" Then Exit Sub
Application.EnableEvents = False
'
Target.Font.Size = IIf(Target.Font.Size < 16, 48, 11)
Target.RowHeight = IIf(Target.RowHeight > 40, 20, 50)
[A1].Select
'
Application.EnableEvents = True
'
End Sub

A+

210loupe.xlsm (16.12 Ko)

@sabV

Bonjour et merci de m'avoir répondu

de quel façon votre macro est-elle exécuté ?

Par un raccourci clavier pour zoomer, et un autre pour revenir à l'affichage initial.

y a t'il un bouton ? si oui, ce bouton est-il placer sur la ou les lignes figées au haut de la feuille (à quel adresse?) ?

Ma macro est enregistrée dans mon classeur de macros personnelles, comme ça je peux l'utiliser dans n'importe quel classeur, sans avoir besoin d'y installer un bouton.

si il y a une ou plusieurs ligne figées au haut de la feuille,

est ce qu'on pourrait y affiché/masqué un TexBox ayant une Font appropriée ?

En général il y a des lignes cachées en haut de mes feuilles, mais ce n'est pas systématique.


@curulis57

Merci pour ta réponse.

Ça marche en effet, mais le problème avec ta méthode, c'est que n'importe quel double-clic déclenche un zoom, alors que je n'ai besoin de zoomer que quelques fois par jour....

Bonjour à tous,

Une autre méthode :

Code à placer dans le module ThisWorkbook (qui le rend opératoire dans tout le classeur)

Const zm = 2
Dim celz As Picture

Sub SuppriCelz()
    celz.Delete
    Set celz = Nothing
End Sub

Private Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
    If celz Is Nothing Then
        Target.Copy
        Application.ScreenUpdating = False
        Set celz = Sh.Pictures.Paste(link:=True)
        Application.CutCopyMode = False
        With celz
            .Width = .Width * zm
            .Height = .Height * zm
            .Left = (Application.Width - .Width) / 2
            .Top = (Application.Height - .Height) / 2
            .Interior.Color = RGB(255, 255, 153)
            .OnAction = "ThisWorkbook.SuppriCelz"
        End With
        Cancel = True
    End If
End Sub

Au double clic sur une cellule, une image grossie de cette cellule est placée au centre de la fenêtre.

Au clic sur l'image, elle disparaît.

La constante zm déclarée en tête de module définit le facteur de grossissement (on peut modifier sa valeur).

Si on veut ne l'appliquer qu'à une seule feuille, transférer le code dans le module de la feuille, modifier la déclaration de la proc. d'évènement au profit de l'évènement double-clic de la feuille, et remplacer ThisWorkbook par le nom de code de la feuille sur la ligne OnAction... et Sh par Me sur la ligne Set celz =...

Cordialement

Bonjour,

Merci beaucoup pour ta réponse.

J'ai suivi tes instructions mais je bute sur un problème : ThisWorkbook contient déjà du code, et ça fait bugger la macro sur :

Const zm = 2

Dim celz As Picture

Je ne sais pas comment contourner cette difficulté...

Cela dit, je préfèrerais lancer la macro par un raccourci clavier plutôt qu'un double clic, qui peut être utile par ailleurs.

Le lancement peut être fait par n'importe quoi, ça s'adapte... Par contre, j'ai un peu de mal à imaginer que ça bogue sur des déclarations de variable et constante !

J'ai placé le code au-dessus d'une ligne qui contient :

Private Sub Workbook_Activate()

et du coup ça marche !

Parfois le texte est à moitié mangé derrière le séparateur horizontal, mais je ne sais pas pourquoi ça se passe dans certains fichiers et pas dans tous.

Quant au lancement, je préfèrerais l'effectuer par un raccourci clavier.

Et l'idéal serait que le code soit dans le classeur de macros personnelles, pour ne pas avoir à le coller dans chaque nouveau classeur.

En tous cas, merci bcp bcp pour ton aide.

Ah ! Tu avais placé des déclarations après des procédures !!

Les déclarations doivent toujours être en tête de module, avant toute procédure.

Si la méthode "image" te convient (elle a l'avantage de ne rien modifier dans le classeur, et il n'y a donc rien à rétablir, ni à veiller à une quelconque remise en ordre à la fermeture ou à l'enregistrement...), je t'en fais une adaptation en module standard, macro ordinaire, appelable par un raccourci.

Cordialement.

Pardon pour ces erreurs, mais je suis 100% autodidacte, niveau 1/100....

Oui, la méthode me convient parfaitement.

Et un module standard, macro ordinaire, appelable par un raccourci, ce serait super.

Merci encore.

On apprend en s'échaudant... !

OK, pas le temps pour l'instant, mais je m'en occupe dans la soirée...

A mettre dans un module standard :

Const zm = 2
Dim celz As Picture

Sub SuppriCelz()
    celz.Delete
    Set celz = Nothing
End Sub

Sub ZoomCel()
    If celz Is Nothing Then
        Application.ScreenUpdating = False
        Selection.Copy
        Set celz = ActiveSheet.Pictures.Paste(link:=True)
        Application.CutCopyMode = False
        With celz
            .Width = .Width * zm
            .Height = .Height * zm
            .Left = (Application.Width - .Width) / 2
            .Top = (Application.Height - .Height) / 2
            .Interior.Color = RGB(255, 255, 153)
            .OnAction = "SuppriCelz"
        End With
    End If
End Sub

Tu pourras affecter un raccourci à ZoomCel.

NB- Si tu sélectionnes plusieurs cellules, le grossissement s'appliquera à l'ensemble.

Cordialement.

Bonjour gloub,

voici une autre proposition avec un shape (rectangle) qui s'affiche lorsqu'une cellule de la colonne des numéros de tél est sélectionnée. dans cette exemple j'ai supposé que cette colonne est "B"

le shape devient invisible lorsqu'une cellule d'une autre colonne est sélectionnée ou que la cellule est vide.

page code ThisWorkbook

Private Sub Workbook_BeforeClose(Cancel As Boolean)
effaceShape
End Sub

Private Sub Workbook_Open()
AjoutShape
Range("B1").Select
End Sub

page code de l'onglet des numéros de tél

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set isect = Application.Intersect(Target, Range("B:B"))
If Target.Count > 1 Then Exit Sub
With ActiveSheet.Shapes("Rectangle 1")
  If Not isect Is Nothing And Target.Value <> "" Then
      .Visible = True
      .Left = Target.Left + Target.Width
      .Top = Target.Top - Target.Height
      .TextFrame.Characters.Text = Target
  Else
      .Visible = False
  End If
End With
End Sub

Module1

Public obj
Sub effaceShape()
On Error Resume Next
ActiveSheet.Shapes("Rectangle 1").Delete
End Sub

Sub AjoutShape()
Dim Nom As String
Dim obj As Object
l = 0.75
t = 0.75
w = 180
h = 30
   With ActiveSheet
       Set obj = .Shapes.AddShape(msoShapeRectangle, l, t, w, h)
       With obj
       .Name = "Rectangle 1"
'         .OnAction = "test"
'         .Placement = xlFreeFloating
         .Fill.Solid
         .Fill.Transparency = 0#
         .Fill.ForeColor.RGB = RGB(222, 222, 222) ' couleur de fond
         .Line.BackColor.RGB = RGB(0, 0, 0)  ' couleur de contour
         .Line.DashStyle = msoLineSolid
         .Line.Style = msoLineSingle
         .Line.Visible = msoTrue
         .Line.Weight = 1
           With .TextFrame.Characters
             .Text = "1-000-000-0000"
             .Font.Name = "Arial"
             .Font.Size = 22
             .Font.Bold = False
             .Font.Shadow = True
             .Font.ColorIndex = xlAutomatic      ' couleur de texte
           End With
       End With
   End With
End Sub

@MFerrand

Merci bcp, ça fonctionne super. Au-delà de mes espérances....

...reste un petit problème : la macro SuppriCelz ne fonctionne pas.

je le message d'erreur suivant : "impossible d'exécuter la macro 'SuppriCelz'. il est possible qu'elle ne soit pas disponible dans ce classeur ou que toutes les macros soient désactivées.'

Je ne sais pas quoi faire.

@sabV

Merci d'avoir persévéré.

j'ai un souci : dès que je clique dans une cellule, je reçois un message d'erreur :

"erreur d'exécution '-2147024809 (80070057)':

L'élément portant ce nom est introuvable."

Et je ne sais pas trop quoi en faire...

Bonsoir,

Vérifie dans quel module tu as placé le code. Il doit être dans un module standard.

Vérifie aussi que la macro apparaît bien dans la boîte de dialogue macro, et qu'elle apparaît uniquement sous son nom, sans être précédée d'un nom de module.

A priori j'ai tout bien fait.

J'ai testé les 2 macros dans le classeur de macros personnelles et dans un classeur normal.

Même résultat.

J'ai fait les vérifications que tu indiques, mais tout semble normal.

Précisions peut-être utiles :

  • à mon bureau (sur Excel 2013) : je peux zoomer, mais la macro pour supprimer l'image est inactive.
  • chez moi (sur Excel 2003) : aucune des 2 macros ne fonctionne.

Mystère...

Rien d'incompatible avec 2003. J'ai d'ailleurs été la tester sous Excel 2000, elle fonctionne.

Je ne vois donc pas ou peut être le problème.

Là où tu as seulement la suppression qui ne fonctionne pas, tu peux vérifier par clic droit sur l'image et Affecter une macro, que la macro SuppriCelz est bien affectée à l'image.

Tu peux aussi essayer de tester en remplaçant la déclaration As Picture par As Object.

Bingo !

C'était ça : avec As Objet, ça marche comme sur des roulettes !

Merci 1000 fois !

Bonjour,

j'ai fais une version pour xl 97-2003

en espérent que celle-ci fonctionne

Oui, ça marche. C'est cool.

Merci beaucoup !!!

Rechercher des sujets similaires à "zoomer puis revenir affichage initial"