XL 2010 Zoom auto à l'ouverture et après

safranien · 18 Juillet 2020

Bonjour à tous

mon fichier joint étant amené à être utilisé par plusieurs personnes, j'ai défini dans ThisWorkbook le code suivant afin que le zoom s'adapte à l'ouverture du fichier pour afficher la zone A1 : EA20. Les futurs utilisateurs ayant tous des écrans avec des résolutions différentes :

VB:

Sub Workbook_Open()

Range("A1:EA20").Select
ActiveWindow.Zoom = True

End Sub

En C4 de ma feuil1, j'ai un menu déroulant et ce code pour pouvoir faire un zoom afin que la liste déroulante soit plus lisible :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'updateby Extendoffice 20160530
    On Error GoTo LZoom
    Dim xZoom As Long
    xZoom = Range("B2").Value
    If Target.Validation.Type = xlValidateList Then xZoom = 140
    
LZoom:
    ActiveWindow.Zoom = xZoom
    
End Sub

Et en cellule B2, l'utilisateur définit la valeur de zoom à laquelle revenir après avoir fait un choix dans le menu déroulant et après avoir cliqué n'importe où sur la feuille.

Ce que je cherche à faire est :
1) qu'après avoir choisi une valeur dans le menu déroulant, le zoom revienne automatiquement à la valeur optimale comme c'est le cas avec le code à l'ouverture du classeur
2) qu'il n'y ait pas besoin de faire un clic n'importe où dans la feuille après avoir fait le choix dans le menu déroulant pour activer le retour au zoom normal

Pouvez vous m'aider?

En vous remerciant

job75 · 18 Juillet 2020

Si vous ne voulez pas de cadrage à l'ouverture utilisez ce fichier (3) et la macro :

VB:

Sub Workbook_Open()
Dim sel As Range
With Feuil1 'CodeName, à adapter
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    .Visible = xlSheetVisible 'si la feuille est masquée
    .Activate
    Set sel = Selection 'mémoris la Selection
    [A1:EA1].Select
    ActiveWindow.Zoom = True
    Me.Names.Add "MonZoom", ActiveWindow.Zoom 'nom défini
    Application.EnableEvents = True
    sel.Select
End With
End Sub

safranien · 18 Juillet 2020

allez hop, j'avance doucement. Ci-joint la nouvelle version. Ca fait une partie du job. A l'ouverture du fichier, je récupère la valeur du zoom ajusté que j'inscris dans la cellule B2.
Il me reste à trouver comment revenir au zoom normal après avoir choisi une valeur dans le menu déroulant.
Au passage, j'ai ajouté SendKeys "%{down}" ouvre de suite le menu déroulant quand on clique sur la cellule E3. Par contre, ça me génère un nouveau problème, ça me désactive le pavé numérique !! Pourquoi?

job75 · 18 Juillet 2020

Bonjour safranien,

Dans ThisWorkbook :

VB:

Sub Workbook_Open()
Application.ScreenUpdating = False
Application.EnableEvents = False
With Feuil1 'CodeName, à adapter
    Application.Goto [A1:EA20]
    ActiveWindow.Zoom = True
    Me.Names.Add "MonZoom", ActiveWindow.Zoom 'nom défini
    .[C4] = "" 'RAZ
    Application.Goto .[A1], True 'cadrage
End With
Application.EnableEvents = True
End Sub

Dans le code de Feuil1 :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveWindow.Zoom = IIf(Intersect(ActiveCell, [C4]) Is Nothing, [MonZoom], 140)
End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [C4]) Is Nothing And [C4] <> "" Then [A1].Select
End Sub

A+

safranien · 18 Juillet 2020

Bonjour job75

magnifique !! Merci beaucoup. Je n'arrive pas à trouver où insérer
SendKeys "%{down}"
pour que le menu déroulant s'ouvre dès que l'on clique dessus.
Pourriez vous me dire?
Un autre souci. Quand je ferme le fichier et que je l'ouvre, la zone de menu déroulant est vide. Pourquoi ça ne garde pas la dernière valeur choisie? Dans mon vrai fichier, mon menu déroulant s'étale sur plusieurs cellules fusionnées.

safranien · 18 Juillet 2020

j'ai modifié les codes pour ne plus que la valeur contenue dans la zone de la liste déroulante soit effacée en supprimant cette ligne dans ThisWorkbook

VB:

.[C4] = "" 'RAZ

et cette partie dans le code de la feuil

Code:

 Is Nothing And [C4] <> ""

et pour que la liste s'ouvre quand on clique dessus en ajoutant :

Code:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$C$4:$D$4" And Target.Count = 2 Then
      SendKeys "%{down}"
End If
ActiveWindow.Zoom = IIf(Intersect(ActiveCell, [C4]) Is Nothing, [MonZoom], 140)

End Sub

Est ce que ça vous parait bon écrit ainsi?
Dans le code de ThisWorkbook, pour

Code:

With Feuil1 'CodeName, à adapter

est ce qu'on ne peut pas faire référence au nom réel de la feuil (Feuil) et non pas au nom de l'onglet? Comme ça si qqun change le nom de l'onglet, ça ne fera pas beuguer la macro.

Egalement, si je fige par exemple en E5, que je travaille sur la ligne 200, je sauvegarde et ferme le fichier. Lorsque j'ouvre de nouveau le fichier, l'affichage n'est plus sur la ligne 200 mais est remonté tout en haut, et je suis obligé de faire defiler les lignes pour retourner à la igne 200.

Affichage quand je sauvegarde et ferme

Affichage quand j'ouvre le fichier

Fichier en PJ.

job75 · 18 Juillet 2020

est ce qu'on ne peut pas faire référence au nom réel de la feuil (Feuil) et non pas au nom de l'onglet? Comme ça si qqun change le nom de l'onglet, ça ne fera pas beuguer la macro.

Visiblement vous n'avez pas compris ce qu'est le CodeName d'une feuille, renseignez-vous.

Dans ce fichier (2) j'ai enlevé la RAZ de C4 à l'ouverture.

Et j'ai modifié la SelectionChange pour dérouler la liste :

VB:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Intersect(ActiveCell, [C4]) Is Nothing Then
    ActiveWindow.Zoom = [MonZoom]
Else
    ActiveWindow.Zoom = 140
    CreateObject("wscript.shell").SendKeys "%{DOWN}" 'déroule la liste
End If
End Sub

CreateObject("wscript.shell").SendKeys ne désactive pas le pavé numérique.

safranien · 18 Juillet 2020

effectivement, je me suis mélangé les pinceaux avec le CodeName. Désolé.

Pour que le fichier s'ouvre à la ligne où l'on a sauvegardé en fermant (quand on fige les volets), j'ai remplacé dans ThisWorkbook

VB:

Application.Goto .[A1], True 'cadrage

par

Code:

Range("B4").Select

Egalement, j'ai remis dans le code

Code:

Application.ScreenUpdating = True

Ca vous semble correct?

job75 · 18 Juillet 2020

Si vous ne voulez pas de cadrage à l'ouverture utilisez ce fichier (3) et la macro :

VB:

Sub Workbook_Open()
Dim sel As Range
With Feuil1 'CodeName, à adapter
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    .Visible = xlSheetVisible 'si la feuille est masquée
    .Activate
    Set sel = Selection 'mémoris la Selection
    [A1:EA1].Select
    ActiveWindow.Zoom = True
    Me.Names.Add "MonZoom", ActiveWindow.Zoom 'nom défini
    Application.EnableEvents = True
    sel.Select
End With
End Sub

safranien · 18 Juillet 2020

Super !! Vous êtes magique !!!
Je pense que là on est pas mal.

Si je peux abuser de votre temps et gentillesse, savez vous si il existe un moyen de pouvoir faire défiler la liste déroulante avec la roulette de la souris en paramétrant le nombre de valeurs qui défilent à chaque scroll? Car dans mon fichier de travail, ma liste déroulante comporte plusieurs centaines de valeurs. Je ne veux (peux) pas utiliser de userform ou autre (dans un autre poste dans lequel vous m'avez également répondu, une liste déroulante via Combobox me relance plusieurs fois les calculs dans mon fichier).

job75 · 18 Juillet 2020

Sur une liste de validation ce n'est pas possible.

C'est possible sur une ComboBox ou une ListBox (contrôles ActiveX) :

https://www.excel-downloads.com/thr...une-combobox-listbox-avec-la-roulette.184564/

safranien · 18 Juillet 2020

D'accord.
Merci encore pour votre aide.
Bon week end

XL 2010 Zoom auto à l'ouverture et après

safranien

XLDnaute Occasionnel

Pièces jointes

job75

safranien

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

safranien

XLDnaute Occasionnel

safranien

XLDnaute Occasionnel

Pièces jointes

job75

XLDnaute Barbatruc

Pièces jointes

safranien

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

Pièces jointes

safranien

XLDnaute Occasionnel

job75

XLDnaute Barbatruc

safranien

XLDnaute Occasionnel

Discussions similaires