[Toutes versions] Adapter le zoom des feuilles Excel à la résolution de l'écran [Résolu]

[Chagui]

Bonjour,

Ce post n'a pas pour but de demander de l'aide mais de proposer une solution d'adaptation du zoom en fonction de la résolution de l'écran.

Dans mon cas précis, je me suis retrouvé à mettre en forme un fichier excel avec une résolution d'écran de 1440x900. Mon zoom était donc à 100% et le contenu restait visible dans sa largeur.
Ce fichier excel doit être utilisé par plusieurs personnes. Le problème dans l'entreprise ou je travaille, c'est que tout le monde n'a pas les mêmes écrans et même si 2 postes se trouvent avec la même taille d'écran, il savère qu'ils n'ont pas toujours la même résolution.

Lorsque l'on veut vraiment personnaliser un fichier excel et que pour une question esthétique, on souhaite cacher la barre de défilement horizontale, les personnes ayant une résolution d'écran inférieure à 1440x900 se trouve bloqué au niveau de l'affichage et une partie des informations ne sont pas visible en largeur. Rendre le défilement horizontale visible est bien entendu possible mais je trouve que pour une question d'ergonomie ce n'est pas agréable de devoir "scroller" horizontalement. De plus passer d'une résolution 1440 x 900 à 1024 x 768 en gardant le zoom a 100% est assez catastrophique on peut le dire et s'amuser à changer feuille par feuille le zoom peut vite devenir ennuyeux.

voici la solution que j'ai trouvé :

Code :

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
 
'Code à mettre dans un module
option explicit
 
'déclarer L'API
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
 
'Macro à appeler à l'ouverture du classeur
Sub choixzoom()
 
Dim Largeur As Integer, Hauteur As Integer
 
  Largeur = GetSystemMetrics(0) 'récupère la largeur de l'écran en pixel
  Hauteur = GetSystemMetrics(1) ' récupère la longueur de l'écran en pixel
 
If Largeur = 1440 And Hauteur = 900 Then
ActivZoom (100) 'appliquer le poucentage voulu
ElseIf Largeur = 1152 And Hauteur = 864 Then
ActivZoom (80)
ElseIf Largeur = 1024 And Hauteur = 768 Then
ActivZoom (73)
Else
ActivZoom (89) ' Mon fichier est visible à 89% pour toutes les autres résolutions d'écran 
End If
End Sub
 
'Macro qui applique le zoom à chaque feuille du classeur
Sub ActivZoom(z As Integer)
Dim i As Byte
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
Sheets(i).Visible = xlSheetVisible
Sheets(i).Activate
ActiveWindow.Zoom = z
Next i
Application.ScreenUpdating = True
Sheets(1).Activate
End Sub

En partant de mon fichier adapté pour une résolution 1440 x 900, j'ai testé chaque résolution possible afin de trouver le poucentage de zoom qui convient. Je joint un fichier excel "exemple" avec tous les types de résolutions et le zoom adapté. (Bien entendu cela peut être variable pour chacun a quelque pourcent pres): Fichier excel "exemple"

Je souhaitais partager cela afin de pouvoir peut être aider des personnes se trouvant dans le même cas.


Cordialement.

[patricktoulon]

bonjour

to idée n'est pas mal mais en fait valable que dans ton cas

puisque le zoom sert a t'afficher que selon le cas de ton fichier


mon idée :

il faudrait compter les colonnes utilisées avec limite max du nombre

calculer la dimention en largeur du groupe de celulle et convertir en pixel
tu divise la resolution max qui est de 1440 par la dimention obtenue

ensuite reste a diviser 100 par le chiffre obtenue
tu aurras le zoom final


au plaisir

[Chagui]

Hello

Merci pour ta propisition

Par contre la ou je bloque c'est pour la conversion de la largeur en pixel.

voici mon petit code de départ :

Code :

1
2
3
4
5
6
7
8
9
10
11
Dim NbreColumn As String
Dim X As Integer
NbreColumn = Range("A11").End(xlToRight).Column
 
For X = 1 To NbreColumn
 
Z = Cells(11, X).ColumnWidth
Y = Y + Z
Next X
 
MsgBox (Y)

Il faudrait donc convertir la variable y en pixel ? as-tu une idée pour faire cela ?

Merci

[patricktoulon]

bonjour


au plus simple

y=y*0.75

[patricktoulon]

bonjour voila une petite macro qui fait exactement ce que je te disais


le zoom s'adapte au nombre de colonnes

Code :

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate()
 Application.ScreenUpdating = False
 ActiveWindow.ScrollColumn = 1
 ActiveWindow.ScrollRow = 1
 Range("A1:q10").Select'ici tu selectionne la plage que tu veux elle sera zommée pour remplir tout l'ecran quelque se soit la resolution de ton ecran
 ActiveWindow.Zoom = True
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub

au plaisir

[patricktoulon]

et meme mieux
la grille t'affiche directement la selection dans toute la fenetre

Code :

1
2
3
4
5
6
7
8
9
Private Sub Worksheet_Activate()
 Application.ScreenUpdating = False
 Range("d20:h30").Select'ici tu selectionne la plage que tu veux elle sera zommée pour remplir tout l'ecran quelque se soit la resolution de ton ecran
ActiveWindow.ScrollColumn = selection.column
 ActiveWindow.ScrollRow = selection.row
  ActiveWindow.Zoom = True
 Range("A1").Select
 Application.ScreenUpdating = True
 End Sub

[Chagui]

Hello Patrick,

Je réponds avec un peu de retard car je n'avais pas vu tes messages ( un petit moment que je ne m'étais pas connecté au forum).

Je n'ai pas encore testé mais ce que tu proposes à l'air exelent !!!!

Je vais rapidement essayer ca dans la journée

Merci !!!