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
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
| Option Explicit
Public Declare Function GetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long) As Long
Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare Function SetWindowLongA Lib "user32" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
Public Declare Function SHAppBarMessage Lib "shell32.dll" (ByVal dwMessage As Long, pData As AppBarData) As Long
Public Type RECT
Left As Long
Top As Long
Right As Long
Bottom As Long
End Type
Public Type AppBarData
cbSize As Long
hwnd As Long
uCallbackMessage As Long
uEdge As Long
rc As RECT
lParam As Long
End Type
Sub restaurer_croix_sys()
Dim hwnd As Long
hwnd = GethandleApp
SetWindowLongA hwnd, -16, &H15CF0000
DrawMenuBar hwnd ' on redessine (pour les petit defaut)
End Sub
Sub supprimer_croix_sys()
Dim hwnd As Long
hwnd = GethandleApp
'SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
SetWindowLongA hwnd, -16, &H15070000 'on enleve la caption
ShowWindow hwnd, 3 ' on affiche plein ecran
DrawMenuBar hwnd ' on redessine (pour les petit defaut)
End Sub
Sub affichage_normal()
Application.OnKey "{ESCAPE}" ' on débloque la touche esc
ChangeTaskBar 0 'on remet la barre des taches
restaurer_croix_sys 'on remet la caption de l'application
Application.ScreenUpdating = False 'on ne rafraichie pas l'affichage
Application.DisplayFullScreen = False 'on en remet le ruban
ActiveWindow.DisplayHeadings = True 'on remet les entetes de colonne
Application.DisplayFormulaBar = True ' on remet les barre de formule
ActiveWindow.DisplayGridlines = True ' on affiche la grille
ActiveWindow.DisplayHorizontalScrollBar = True 'on affiche la scrollbar horizontale
ActiveWindow.DisplayVerticalScrollBar = True 'on affiche la scrollbar verticale
ActiveWindow.DisplayWorkbookTabs = True 'on affiche la barre de titre des onglets
Application.WindowState = xlMaximized 'on affiche l'application complete en plein ecran
End Sub
Sub affichage_plein_ecran()
Application.OnKey "{ESCAPE}", "" ' on bloque la touche esc
Application.ScreenUpdating = False ' on bloque le refraichissement(effet visuel deagréable)
Application.DisplayFullScreen = True 'on enleve le ruban
ActiveWindow.DisplayHeadings = False 'on enleve les entetes de colonnes
Application.DisplayFormulaBar = False 'on enleve la barre des formules
'ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHorizontalScrollBar = False 'on enleve la scrollbar horizontale
ActiveWindow.DisplayVerticalScrollBar = False 'on eleve la scrollbar verticale
ActiveWindow.DisplayWorkbookTabs = False 'on enleve la barre de titre des onglets
ChangeTaskBar 1 'on enleve la barre des taches WINDOWS
supprimer_croix_sys 'on enleve la caption de l'application
End Sub
' Trouver le hwnd de la barre des tâches
Private Function Gethandlebartache() As Long
Gethandlebartache = FindWindowA("shell_traywnd", "")
End Function
' Trouver le hwnd de l'application
Private Function GethandleApp() As Long
GethandleApp = FindWindowA(vbNullString, Application.Caption)
End Function
'Applique les propriétés à la barre des taches
'Mode = 0 : voir la barre des tâche
'Mode = 1 : cache la barre des tâches
Public Function ChangeTaskBar(Mode As Long)
Dim BarDt As AppBarData
Dim ret As Long
'Entrée des paramètres
BarDt.cbSize = Len(BarDt)
BarDt.hwnd = Gethandlebartache
BarDt.lParam = Mode
'Applique
ret = SHAppBarMessage(&HA, BarDt)
If ret = 0 Then
Call MsgBox("erreur lors de l'appel de SHAppBarMessage", vbCritical + vbOKOnly, "Erreur")
End If
End Function |
Plein écran complet
Répondre avec citation
: ça peut servir aux autres 
Partager