XL 2010 Résolu par Roland : adapter à l'écran toutes les feuilles du classeur

[Usine à gaz]

Bonjour à toutes et à tous,

J'ai un code dans chaques feuilles de mon classeur qui me permet d'adapter à l'écran.
- les colonnes à afficher sont différentes pour toutes les feuilles.

Private Sub Worksheet_Activate()
ActiveWindow.DisplayHeadings = False
Range("A:X").Select 'adapter à l'écran à préciser
ActiveWindow.Zoom = True

J'aimerais ou j'ai besoin LOL que le code soit mis dans le thisworkbook et passe à l'ouverture du classeur toutes les feuilles en les adaptant à l'écran.

J'ai tenté de copier le code (1 par feuille avec ses colonnes à afficher) et ça ne marche pas.

Auriez-vous une idée ?
Je joins un classeur test.
Avec mes remerciements,
Amicalement,
Lionel,

 

[GeoTrouvePas]

Bonjour,

QQchose comme ça devrait faire l'affaire :

Private Sub Workbook_Open()
    Dim Feuille As Worksheet
    For Each Feuille In ThisWorkbook.Sheets
        Feuille.Activate
        Feuille.Range("A:X").Select
        ActiveWindow.Zoom = True
    Next
End Sub

 

[Usine à gaz]

Bonjour Géo,

Merci de m'avoir répondu et pour le code.
Je teste dès que j'ai un moment et je reviens vers vous.
Amicalement,
Lionel,

 

[Roland_M]

bonjour tout le monde,

ou encore dans le thiswork,
qui je pense serait préférable au cas des modifications sont apportées le zoom s'adaptera chaque fois !
Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.DisplayHeadings = False
Range("A:X").Select 'adapter à l'écran à préciser
ActiveWindow.Zoom = True
End Sub

 

[Roland_M]

re

je n'avais pas chargé le fichier et donc pas vu ta demande complète !
voir comme ceci avec le nom des feuilles à adapter bien entendu si tu changes les noms !?

mais à mon avis ça va pas le faire car il faudrait le nombre de lignes !?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.DisplayHeadings = False
R$ = ""
Select Case Sh.Name
  Case "Feuil1": R$ = "b:l"
  Case "Feuil2": R$ = "b:m"
  Case "Feuil3": R$ = "b:n"
  Case "Feuil4": R$ = "b:o"
  Case "Feuil5": R$ = "b:p"
End Select
If R$ > "" Then Range(R$).Select: ActiveWindow.Zoom = True
End Sub

 

[Usine à gaz]

Bonjour Roland ...... ça fait longtemps LOL
Merci de m'avoir répondu.
Je teste dès que j'ai un moment et je te dis.

Je me permets LOL.
J'ai un autre fil en cours qui est très important pour moi.
Voudrais-tu si tu as un moment y "jeter" un oeil ?
le titre est : code recherche + format n° tel

Des grands Merci ...
Amicalement,
Lionel,

 

[Roland_M]

re

je vais voir mais là je n'ai plus guère le temps !

mais comme je te disais il faudrait un nombre de lignes pour ton zoom exemple:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.DisplayHeadings = False
R$ = ""
Select Case Sh.Name
  Case "Feuil1": R$ = "b1:l50"
  Case "Feuil2": R$ = "b1:m50"
  Case "Feuil3": R$ = "b1:n50"
  Case "Feuil4": R$ = "b1:o50"
  Case "Feuil5": R$ = "b1:p50"
End Select
If R$ > "" Then Range(R$).Select: ActiveWindow.Zoom = True: Range("B1").Select
End Sub

 

[Usine à gaz]

OK, je vais voir en testant pour les lignes.
Pour l'autre fil, ça attendra que tu aies un moment, c'est déjà super que tu veuilles regarder.
Merci Roland,
Amicalement,
Lionel,

 

[Roland_M]

re

va voir ta solution !

après ceci > If Quoi = "" Then Exit Sub
Quoi = Format(Quoi, "0#"" ""##"" ""##"" ""##"" ""##")

 

[Usine à gaz]

Merci Rpland,

J'y cours

 

[Usine à gaz]

Bonjour Roland,
Bonjour GéotrouvePas,
Bonjour à toutes et à tous,

J'ai testé mais ça ne fonctionne pas.
Je pense avoir résolu le problème d'affichage avec ce code :

Private Sub Workbook_Open()
ActiveWindow.DisplayHeadings = False
Sheets("Feuil1").Select
    Range("b:m").Select 'adapter à l'écran à préciser
    ActiveWindow.Zoom = True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    Range("A1").Select
   
Sheets("Feuil2").Select
    Range("b:n").Select 'adapter à l'écran à préciser
    ActiveWindow.Zoom = True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    Range("A1").Select
   
Sheets("Feuil3").Select
    Range("b:o").Select 'adapter à l'écran à préciser
    ActiveWindow.Zoom = True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    Range("A1").Select
   
Sheets("Feuil4").Select
    Range("b:p").Select 'adapter à l'écran à préciser
    ActiveWindow.Zoom = True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    Range("A1").Select
   
Sheets("Feuil5").Select
    Range("b:q").Select 'adapter à l'écran à préciser
    ActiveWindow.Zoom = True
    ActiveWindow.DisplayHeadings = False
    ActiveWindow.DisplayGridlines = False
    Range("A1").Select
Sheets("Feuil1").Select
End Sub

Mais je pense que vous avez un meilleur code
J'ai joint le classeur test.

Un grand merci à vous,
Amicalement,
Lionel,

 

[Roland_M]

re

ben oui ! le code que je t'ai mis au poste 5 et 7
code à mettre dans le thisworkbook !
il fonctionne à chaque fois que tu actives une feuille
si tu le mets en Open il ne s'effectuera qu'à l'ouverture
tandis qu'ici si tu fais des modif dans tes feuilles lorsque tu sortiras et reviendra sur cette feuille le zoom s'adaptera si tu as modifié des lignes ou colonnes !?

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
ActiveWindow.DisplayHeadings = False
R$ = ""
Select Case Sh.Name
  Case "Feuil1": R$ = "b1:l50"
  Case "Feuil2": R$ = "b1:m50"
  Case "Feuil3": R$ = "b1:n50"
  Case "Feuil4": R$ = "b1:o50"
  Case "Feuil5": R$ = "b1:p50"
End Select
If R$ > "" Then Range(R$).Select: ActiveWindow.Zoom = True: Range("B1").Select
End Sub

 

[Usine à gaz]

Merci Roland pour ce retour,

Mais je n'arrive pas à faire fonctionner ton code. Je pense, comme tu l'as dit que c'est à cause du fait que je ne définisse pas un nombre de lignes et je ne peux pas définir un nombre de ligne car j'ai des feuilles de plusieurs milliers de lignes.

Effectivement, j'ai besoin que l'adaptation à l'écran ne se fasse qu'à l'ouverture nous n'avons rien à y changer ensuite.

Le problème posé quand l'adaptation se fait à chaque activation d'une feuille est que nous perdons la cellule ou la ligne dans laquelle ont est avant l'activation. D'où perte de temps pour retrouver dans les feuilles de plusieurs milliers de lignes.

Amicalement,
Lionel,

 

[Roland_M]

re

alors prends ceci, et ne me dis pas que ça ne fonctionne pas !

Private Sub Workbook_Open()
Dim Feuille As Worksheet
For Each Feuille In ThisWorkbook.Sheets
    R$ = ""
    Select Case Feuille.Name
     Case "Feuil1": R$ = "b1:l1"
     Case "Feuil2": R$ = "b1:m1"
     Case "Feuil3": R$ = "b1:n1"
     Case "Feuil4": R$ = "b1:o1"
     Case "Feuil5": R$ = "b1:p1"
   End Select
   If R$ > "" Then
      Feuille.Activate
      Range(R$).Select: ActiveWindow.Zoom = True
      ActiveWindow.DisplayHeadings = False: Range("A1").Select
   End If
Next
End Sub

 

[Usine à gaz]

Merci Roland,

Évidemment, on sent le PROS LOL.
C'est nickel.
Super Merci à toi,
Amicalement,
Lionel,