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

safranien

XLDnaute Occasionnel
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
 

Pièces jointes

  • essai2.xlsm
    20.2 KB · Affichages: 9
Solution
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

XLDnaute Occasionnel
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?
 

Pièces jointes

  • essai2.xlsm
    21.5 KB · Affichages: 3

job75

XLDnaute Barbatruc
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+
 

Pièces jointes

  • essai(1).xlsm
    20.6 KB · Affichages: 13

safranien

XLDnaute Occasionnel
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.
 
Dernière édition:

safranien

XLDnaute Occasionnel
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

1595077249424.png


Affichage quand j'ouvre le fichier

1595077287212.png


Fichier en PJ.
 

Pièces jointes

  • essai3.xlsm
    19.3 KB · Affichages: 3
Dernière édition:

job75

XLDnaute Barbatruc
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.
 

Pièces jointes

  • essai(2).xlsm
    21 KB · Affichages: 7
Dernière édition:

safranien

XLDnaute Occasionnel
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

XLDnaute Barbatruc
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
 

Pièces jointes

  • essai(3).xlsm
    21.5 KB · Affichages: 12

safranien

XLDnaute Occasionnel
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).
 

Discussions similaires

Réponses
2
Affichages
129

Statistiques des forums

Discussions
311 711
Messages
2 081 796
Membres
101 817
dernier inscrit
carvajal