Application en plein ecran sans la caption et barre des taches new version

**patricktoulon** · 02/05/2014, 13h57

Bonjour gotmilck
j'ai cherché dans mes archives et je l'ai retrouvé
voila le code du module a mettre dans un module standard version 32 et 64 bits
lance affichage_plein_ecran pour le plein écran et affichage normal pour revenir a un affichage complet
Evite de faire tes demande par MP surtout quand c'est une première demande
si tu l'avais fait ici je l'aurais reçu quand même
attention dans cette version il n'y a plus les bouton de la caption si il te faut les boutons demande ICI!!!!

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Option Explicit
#If win64 Then
#If VBA7 Then
Public Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
#ElseIf VBA6 Then
 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
#End If
#Else
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
 
 
 #End If
 Public madate As String
Public titre_email As String
Sub restaurer_croix_sys()
  Dim hWnd As Long
  hWnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) Or &H80000
End Sub
Sub supprimer_croix_sys()
  Dim hWnd As Long
  hWnd = FindWindowA(vbNullString, Application.Caption)
  SetWindowLongA hWnd, -16, GetWindowLongA(hWnd, -16) And &HFFF7FFFF
End Sub
Sub affichage_normal()
Application.OnKey "{ESCAPE}"
restaurer_croix_sys
Application.ScreenUpdating = False
Application.DisplayFullScreen = False
ActiveWindow.DisplayHeadings = True
Application.DisplayFormulaBar = True
ActiveWindow.DisplayGridlines = True
ActiveWindow.DisplayHorizontalScrollBar = True
ActiveWindow.DisplayVerticalScrollBar = True
ActiveWindow.DisplayWorkbookTabs = True
Application.WindowState = xlMaximized
End Sub
Sub affichage_plein_ecran()
Application.OnKey "{ESCAPE}", ""
Application.ScreenUpdating = False
supprimer_croix_sys
Application.DisplayFullScreen = True
ActiveWindow.DisplayHeadings = False
Application.DisplayFormulaBar = False
ActiveWindow.DisplayGridlines = False
ActiveWindow.DisplayHorizontalScrollBar = False
      ActiveWindow.DisplayVerticalScrollBar = False
 ActiveWindow.DisplayWorkbookTabs = False
Application.ScreenUpdating = True
 
End Sub

**patricktoulon** · 03/05/2014, 17h21

Bonjour a tous
comme on me le demande encore j'ai décidé de faire un module simplifié
pour afficher l'application Excel en plein écran sans la captions et la barre des taches Windows
en gros ce que l'on verra c'est juste la grille excel
voici le code a mettre dans un module standard
normalement si je ne me suis pas trompé dans les déclaration des APIs c'est valable pour 32 & 64 bits
une fois votre module remplie
lancer affichage_plein_ecran Pour mettre l'App en plein écran

ou
affichage_normal pour remmettre tout a la normale

Voila bonne utilisation

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
Option Explicit
#If win64 Then
#If VBA7 Then
Public Declare PtrSafe Function GetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long) As Long
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
 
#ElseIf VBA6 Then
 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
 
#End If
#Else
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
 
 #End If
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

**Daniel.C** · 04/05/2014, 11h49

Bonjour Patrick,

Génial !

Pour mon besoin perso, j'aimerais que la fenêtre revienne à sa taille initiale; j'ai essayé :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.WindowState = xlNormal

au lieu de :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

Application.WindowState = xlMaximized

mais ça ne fonctionne pas. Est-ce que je dois noter la position et les dimensions de la fenêtre dans des variables publiques dans la macro "affichage_plein_ecran" ou est-ce qu'il y a plus simple ?

**patricktoulon** · 04/05/2014, 14h31

Re pour l etat de la fenetre Bonjour daniel Essaie plutot avec l api showwindoa avec 1 comme argument

**Daniel.C** · 04/05/2014, 17h30

Merci Patrick, mais je ne connais RIEN aux API (mais j'en apprécie davantage l'usage). Je vais tâcher de faire avec.

**gotmilk** · 06/05/2014, 11h20

Merci beaucoup Patrick,

Mais je suis capable de sortir du plein écran de trois façon.

1- Double click avec le bouton gauche dans la barre windows en haut

2- double click avec le bouton droite et ensuite réduire, par la suite restaurer.

3- Peser sur le bouton gauche en même temps qu'on bouge la souris.

J'aimerais vraiment être capable de bloquer tout ça.

Merci

**patricktoulon** · 06/05/2014, 15h00

Bonjour
je viens de remettre a dispo une version complète dans les contribution sert toi en

**gotmilk** · 07/05/2014, 06h14

Je suis capable de sortir du plein écran en cliquant sur le bouton droite de la souris et fermé le plein écran.

Est-ce qu'il y a un moyen de le bloquer aussi ?

Merci

**patricktoulon** · 07/05/2014, 13h15

Bonjour
Puré il faut tout te faire a toi tu pourrais faire tes recherche avant de poster quand même

voila le nouveau code complet du module

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
 
Option Explicit
#If win64 Then
#If VBA7 Then
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
 
#ElseIf VBA6 Then
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
 
#End If
#Else
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
 
 #End If
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
nobouton True
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
nobouton False
End Sub
Function nobouton(etat)
On Error Resume Next
Application.CommandBars("cell").FindControl(ID:=2951).Enabled = etat
End Function
' 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

**Otman.pro** · 22/05/2014, 12h30

Bonjour Mr.Toulon,

Je vous remercie pour ce programme plein écran très robuste, est ce qu'il y'a un moyen de le faire fonctionner juste pour le fichier Excel actif
(Dans lequel le module de ce programme existe) ? surtout que ma Macro crée d'autres fichiers Excel pour exploitation

Je vous remercie d'avance et pardonnez moi si ma question vous cause un désagrément ou dérangement, j'ai cherché cela mais je n'ai pas trouvé

Otman

**patricktoulon** · 22/05/2014, 13h11

Re
Bonjour

pour ton besoins il te suffit de déterminer l'application dans le findwindows pour le handle

en gros un variable déterminant ton app correspondant a ton classeur base par dans le find Windows

n'en sachant pas plus sur le contexte je ne peut t'en dire plus

ce qui va être un peu compliqué c'est d'ouvrir tout tes classeur dans une app différente a chaque fois
tu vois ce que je veux dire

**Otman.pro** · 22/05/2014, 14h30

Re-bonjour

Merci de ce retour rapide,
Pour décrire un peu le contexte, la macro sert à des fin d'analyse de géométrie de la caisse (Voiture), et permet de faire des extractions Excel
(indicateurs, graphiques,...) avec ce principe :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
FileSaveName = Application.GetSaveAsFilename
'...
Set nouveau_classeur
'...
Nouveau_classeur.SaveAs FileSaveName, FileFormat:=56

J'ai injecté votre module proposé pour des principes d'affichage selon les droit d'accès (mesureur ou ingénierie local), je fait appel
à l'affichage plein écran à l'ouverture (ici mode mesureur par défaut : tout est verrouillé sauf la saisie des résultats)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
Private Sub workbook_open() 
end sub

je fait appel à l'affichage normal quand l'utilisateur déverrouille la macro avec Mot de passe (click sur un bouton)
Ce que j'ai compris de votre réponse, c'est que le Handle est un identifiant unique attribué par l'os à une ressource, pardonnez mon ignorance, mais je ne sais pas comment l'utiliser avec le window find ? la synthaxe de code VBA ? ou écrire le code est ce que dans le Thisworkbook ?

Je vous remercie d'avance

**patricktoulon** · 22/05/2014, 15h18

re

voila un exemple qui ouvre 2 fichier excel dans 2 instances de l' application excel

mais n'enlève le ruban que d'une seule

le code d'appel

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Sub essai_sur_2_app()
Dim app1 As Object, app2 As Object, wb As Object, wb2 As Object
'on créé 2 instance de l'applicatiion excel
Set app1 = CreateObject("Excel.Application")
Set app2 = CreateObject("Excel.Application")
 
'on ouvre un fichier excel avec l' instance n°1 de l'application excel )
Set wb = app1.Workbooks.Open("C:\exemple1.xls")
affichage_plein_ecran (app1) 'on enleve le ruban dans le premier
'on ouvre un fichier excel avec l' instance n°2 de l'application excel )
Set wb2 = app2.Workbooks.Open("C:\exemple2.xls")
End Sub

et maintenant le module de suppression modifié pour tes souhait

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
Option Explicit
#If win64 Then
#If VBA7 Then
Public Declare PtrSafe Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SetWindowLongA Lib "user32" (ByVal hWnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hwnd As Long, ByVal nCmdShow As Long) As Long
Public Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
 
#ElseIf VBA6 Then
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
 
#End If
#Else
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
 
 #End If
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(appp)
  Dim hwnd As Long
  hwnd = GethandleApp(appp)
 SetWindowLongA hwnd, -16, &H15CF0000
DrawMenuBar hwnd ' on redessine (pour les petit defaut)
End Sub
Sub supprimer_croix_sys(appp)
  Dim hwnd As Long
  hwnd = GethandleApp(appp)
  '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(appp)
Application.OnKey "{ESCAPE}" ' on débloque la touche esc
ChangeTaskBar 0 'on remet la barre des taches
restaurer_croix_sys appp '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
nobouton True
End Sub
Sub affichage_plein_ecran(appp)
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 appp 'on enleve la caption de l'application
nobouton False
End Sub
Function nobouton(etat)
On Error Resume Next
Application.CommandBars("cell").FindControl(ID:=2951).Enabled = etat
End Function
' 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(appp) As Long
    GethandleApp = FindWindowA(vbNullString, appp.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

Au plaisir

**Otman.pro** · 24/05/2014, 19h33

Bonjour Mr. toulon,
Merci bien pour le code
Je comprend bien ce que vous avez expliqué, il faut distinguer les fichiers Excel comme des applications différentes,
j'ai essayé de me débrouiller mais je n'ai pas réussi, puisque le code d'appel que vous m'avez donné, je l'ai injecté dans le module d'ouverture, il y'a mes commentaire dans le code ci dessous :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
sub workbook_open()  
Dim app1 As Object, app2 As Object, wb As Object, wb2 As Object
'on créé 2 instance de l'applicatiion excel
Set app1 = CreateObject("Excel.Application")
Set app2 = CreateObject("Excel.Application")
'on ouvre un fichier excel avec l' instance n°1 de l'application excel )
Set wb = app1.Workbooks.Open("C:\exemple1.xls")  ' Ici comment je fais puisque mon premier excel dont je veux appliquer l'affichage est déja ouvert ?
                                                                      ' j'ai essayé ces 4 codes mais ça na pas marcher :
                                                                      ' 1/ Set wb = app1.workbooks.open(activeworkbook.path), 2/ Set thisworkbook = app1.workbooks.open 
                                                                      ' 3/ Set Activeworkbook = app1.workbooks.open, 4/ J'ai supprimé cette ligne aussi puisque le classeur est 
                                                                      ' déja ouvert
affichage_plein_ecran (app1) 'on enleve le ruban dans le premier
'on ouvre un fichier excel avec l' instance n°2 de l'application excel ) 
Set wb2 = app2.Workbooks.Open("C:\exemple2.xls") ' Ici mon deuxième Excel, je l'ouvre quand j'en ai besoin, dans un autre module (M_Indicateur)
                                                                             'Je pense il faut  déclarer son application dans ce module ??
end sub

J'ai remarqué aussi que le menu contextuel (clic droit) des onglets est disparaît , Je l'ai remis avec ce programme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub ResetCommandBars()
Dim x
On Error Resume Next
For x = 1 To Application.CommandBars.Count
With Application.CommandBars(x)
.Reset
.Enabled = True
End With
Next x
End Sub

je suis désolé je ne suis pas doué pour ce genre de programmation avec des fonction agissant sur Windows
Tout le plaisir est a moi et je vous remercie beaucoup pour votre aide

Application en plein ecran sans la caption et barre des taches new version

Contribuez

Discussions similaires

Partager

Partager