XL 2019 Zoom automatique selon la résolution ou la taille écran

[pat66]

Bonjour à tous

Ma résolution est 1366 x 768 et récemment j'ai testé un fichier sur un écran plus petit, malheureusement l'affichage n'était pas optimisé, il était trop petit , il fallait donc zoomer chaque feuilles

est il possible, grâce à une macro, d'optimiser l'affichage de chaque feuille sachant qu'elles n'occupent pas toujours le même nombre de colonnes ni de lignes, et que chacune a donc besoin d'un zoom différent ?

l'idéal serait qu'à l'ouverture du classeur, excel détecte la résolution de l'écran et optimise l'affichage en plein écran, peut être en tenant compte de ma résolution et des zooms du fichier original

un grand merci à tous

Patrick

 

[pat66]

Bonjour patricktoulon

C'est tout simplement parfait! car l'affichage sur HP EliteBook, Écran 13.3" est optimum, il s'adapte à la taille de l'écran

Un grand merci pour ton aide et le temps que tu m'as consacré

Patrick

 

[patricktoulon]

Bonjour patricklopez66
ravi pour toi ,tag ton sujet résolu alors

 

[patricktoulon]

re
si tu veux la meme pour les lignes tu le dis

 

[pat66]

ok merci

bon we

 

[pat66]

Bonjour le forum
Bonjour patricktoulon

Je souhaiterai ajouter une zone ScrollArea sur chaque feuille en plus des instructions du zoom dans le Private Sub Workbook_SheetActivate(ByVal Sh As Object)
Select Case Sh.Name
Case "Feuil1": zooming_columns Range("A:I")
Case "Feuil2": zooming_columns Range("A:m")
Case "Feuil3": zooming_columns Range("A:f")
Case Else: zooming_columns False
End Select

j'ai pensé à rajouter avant le end sub

Worksheets("feuil1").ScrollArea = "A1:i42"
Worksheets("feuil2").ScrollArea = "A1:m20"
Worksheets("feuil3").ScrollArea = "A1:f18"

Je me pose 2 questions:
Est ce la meilleure façon d'ajouter le ScrollArea car des fois mais rarement le zoom ne fonction ne pas
et ensuite ne vaut il pas mieux les écrire sur chaque feuille dans le
Private Sub Worksheet_Activate()

Merci à tous et belle journée

Patrick66

 

[patricktoulon]

bonjour Patrick

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    With Sh
        Select Case Sh.Name
        Case "Feuil1": zooming_columns .Range("A:I"): .ScrollArea = "A1:h42"
        Case "Feuil2": zooming_columns .Range("A:m"): .ScrollArea = "A1:l20"
        Case "Feuil3": zooming_columns .Range("A:f"): .ScrollArea = "A1:e18"
        Case Else: zooming_columns False
        End Select
    End With
End Sub

ça fonctionne très bien comme ça
bien que je me demande a quoi peut bien servir le case else

 

[pat66]

Patrick,

Encore merci pour ton aide, cela fonctionne parfaitement
Peux me dire comment écrire dans ta macro, les feuilles par leur code name au lieu du nom personnalisé ?

merci

 

[patricktoulon]

re

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    With Sh
        Select Case Sh.codeName
        Case "xxxx": zooming_columns .Range("A:I"): .ScrollArea = "A1:h42"
        Case "xxxx": zooming_columns .Range("A:m"): .ScrollArea = "A1:l20"
        Case "xxxxx": zooming_columns .Range("A:f"): .ScrollArea = "A1:e18"
        Case Else: zooming_columns False
        End Select
    End With
End Sub

remplace les x par les codenames

 

[pat66]

Patrick
Désolé, je me suis mal exprimé il ne s'agit pas en fait du code name de la feuille qui correspond au nom personnalisable mais du (name) que l'on trouve dans propriétés tout à fait en haut des propriétés de la feuille

merci

 

[patricktoulon]

???????????????????????????????????????????

 

[pat66]

Il s'agit du (name) du haut "Feuil1" et pas du name "toto"

 

[patricktoulon]

???????????????????????????????????????
ET alors c'est .name et c'est tout
a ben de bon matin un lundi tu commence bien toi

nous somme ici pour rendre un dernier hommage au cerveau de patrickLopez66 qui nous a quitté précipitamment bien trop tôt
faisons lui un dernier au revoir avant qu'il rejoigne notre seigneur
Amen

 

[pat66]

PatrickToulon

tu m'as fais tr
merci pour cet humour matinal çà fait du bien et mille excuses je n'avais pas vu la différence entre tes 2 solutions à savoir : Select Case Sh.Name et Select Case Sh.codeName
Merci encore
Je te souhaite une très belle journée

PS je vais me recoucher encore un peu

 

[patricktoulon]

bonne sieste Patrick a toi aussi une bonne nuit

 

[pat66]

Bonjour le Forum
Bonjour patricktoulon

il arrive de temps en temps que cela ne zoome plus (je dois activer un autre onglet et revenir), est ce que cela pourrait venir du fait que dans la macro, tu as écris :
Dim p_topx, marge#
Dim coeff#

et que plus bas, il n'y a plus le # sur Marge et sur coeff ?

merci

dans Thisworkbook :
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
With Sh
Select Case Sh.Name
Case "Feuil1": zooming_columns .Range("A:I"): .ScrollArea = "A1:h42"
Case "Feuil2": zooming_columns .Range("A:m"): .ScrollArea = "A1:l20"
Case "Feuil3": zooming_columns .Range("A:f"): .ScrollArea = "A1:e18"
Case Else: zooming_columns False
End Select
End With
End Sub

dans un module :

Function zooming_columns(rng As Variant)
Dim p_topx, marge#
Dim coeff#
With ActiveWindow
.Zoom = 100
p_topx = (.ActivePane.PointsToScreenPixelsX(72) - .ActivePane.PointsToScreenPixelsX(0)) / 72
marge = ((.ActivePane.PointsToScreenPixelsX(0) / p_topx) - Application.Left) * (1 + (Abs(ActiveWindow.DisplayVerticalScrollBar)))
If TypeName(rng) = "Range" Then
coeff = (Application.UsableWidth - marge) / rng.Width
.Zoom = 100 * coeff
Else
.Zoom = 100
End If
End With
[A1].Select
End Function