Vba pour afficher une feuil excel en plein ecran

Résolu
achgel Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   -  
achgel Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour,


J'utilise la macro suivante, que j'ai trouver sur net, pour afficher une feuil excel en plein écran,
Le problème c'est que chaque fois que je change d’écran je suis obliger de paramétrer son affichage.

Est ce que il y'a un moyen d'avoir une macro qui pourra gérer tous les types d’écrans.

Merci d’avance 


Option Explicit 
'déclarer L'API 
Private Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long 
Dim Largeur As Integer, Hauteur As Integer 
'Macro à mettre dans un module, et à 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 = 1600 And Hauteur = 900 Then 
ActivZoom (125) 'appliquer le poucentage voulu 

ElseIf Largeur = 1280 And Hauteur = 1024 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 (90) ' Mon fichier est visible à 90% pour toutes les autres résolutions d'écran 
End If 
End Sub



A voir également:

3 réponses

Réponse 1 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Bonjour,

Avec un UserForm et 2 commandbutton
essaie ceci à adapter : 


Option Explicit
Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLongA Lib "user32" _
  (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
  (ByVal hWnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
'plein écran
Private Sub CommandButton1_Click()
Dim hWnd As Long
  hWnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
'plein écran
Application.DisplayFullScreen = True
 'Masquer le quadrillage
    ActiveWindow.DisplayGridlines = False
' Masquer les en-têtes
    ActiveWindow.DisplayHeadings = False
' Masquer les barres de défilement
   ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
' Masquer les onglets de classeur
    ActiveWindow.DisplayWorkbookTabs = False
End Sub
'rétablir
Private Sub CommandButton2_Click()
Dim hWnd As Long
  hWnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H80000
'plein écran
Application.DisplayFullScreen = False
'Masquer le quadrillage
    ActiveWindow.DisplayGridlines = True
' Masquer les en-têtes
    ActiveWindow.DisplayHeadings = True
' Masquer les barres de défilement
   ActiveWindow.DisplayHorizontalScrollBar = True
    ActiveWindow.DisplayVerticalScrollBar = True
' Masquer les onglets de classeur
    ActiveWindow.DisplayWorkbookTabs = True
End Sub
0
achgel Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   1
 
Bonjour cs_Le Pivert

Content de vous retrouver sur CCM
Et merci pour votre réponse

Au fait j'aimerais bien savoir si je pourrais avoir un affichage plein écran sans passer par des commandbutton.
0
Réponse 2 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Mettre dans un module: 


Option Explicit
Private Declare Function FindWindowA Lib "user32" _
  (ByVal lpClassName As String, ByVal lpWindowName As String) As Long

Private Declare Function GetWindowLongA Lib "user32" _
  (ByVal hWnd As Long, ByVal nIndex As Long) As Long

Private Declare Function SetWindowLongA Lib "user32" _
  (ByVal hWnd As Long, ByVal nIndex As Long, _
  ByVal dwNewLong As Long) As Long
  Dim hWnd As Long
'plein écran
 Sub pleinecran()
hWnd = FindWindowA(vbNullString, Application.Caption)
Application.DisplayAlerts = False
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
'plein écran
Application.DisplayFullScreen = True
 'Masquer le quadrillage
    ActiveWindow.DisplayGridlines = False
' Masquer les en-têtes
    ActiveWindow.DisplayHeadings = False
' Masquer les barres de défilement
   ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
' Masquer les onglets de classeur
    ActiveWindow.DisplayWorkbookTabs = False
    Application.DisplayAlerts = True
End Sub
'rétablir
 Sub retablir()
 Application.DisplayAlerts = False
hWnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H80000
'plein écran
Application.DisplayFullScreen = False
'Masquer le quadrillage
    ActiveWindow.DisplayGridlines = True
' Masquer les en-têtes
    ActiveWindow.DisplayHeadings = True
' Masquer les barres de défilement
   ActiveWindow.DisplayHorizontalScrollBar = True
    ActiveWindow.DisplayVerticalScrollBar = True
' Masquer les onglets de classeur
    ActiveWindow.DisplayWorkbookTabs = True
    Application.DisplayAlerts = True
End Sub


mettre dans ThisWorkbook: 

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
retablir
End Sub
Private Sub Workbook_Open()
pleinecran
End Sub


Pour fermer le classeur clic droit sur la feuille: Fermer le plein écran

Voilà
0
achgel Messages postés 108 Date d'inscription   Statut Membre Dernière intervention   1
 
Bonjour cs_Le Pivert

Merci pour votre aide

j'ai utiliser votre macro pour afficher le plain écran

c'est vraiment très gentille de votre part
0
Réponse 3 / 3
cs_Le Pivert Messages postés 7904 Date d'inscription   Statut Contributeur Dernière intervention   729
 
Tu peux aussi attribuer un raccourci clavier à tes macro.

voir ici:

http://www.info-3000.com/vbvba/raccourciclavier.php
0

Discussions similaires

Durée d'une diapositive animée
bibibibi99 -
bibibibi99 -

2 réponses
Afficher toutes les lignes masquées excel
livlarsen -
Mehdiiii -

27 réponses