Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" <pb@nospam.fr> a écrit dans le message de groupe de discussion :
OiXWRqZFKHA.3392@TK2MSFTNGP02.phx.gbl...
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" <pb@nospam.fr> a écrit dans le message de groupe de discussion :
OiXWRqZFKHA.3392@TK2MSFTNGP02.phx.gbl...
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel 2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
La procédure ne requiert aucune référence particulière.
Seulement un copier-coller est suffisant...
As-tu fais (peux-tu) les mises à jour disponibles sur le site
de Microsoft de ta version d'Excel ?
Au delà de ça, je ne peux rien d'autre pour toi.
"pb" a écrit dans le message de groupe de discussion :
O#
Bonjour MichDenis,
Je dois réellement merder quelque part.
J'ai collé ton code dans un module standard et rien ne se passe.
C'est 2007 ou moi qui déconne.
Ou alors j'ai une référence VBA manquante
Ou ma version d'excel en evaluation ne prends pas en charge certaines
fonctionnalités.
Que ce soient tes codes, ceux de Laurent Longre, ou Walkenbach, aucuns ne
fonctionnent ici
Et il faut réellement que j'inhbibe ou masque ces boutons, sinon l'appli
n'a
plus lieu d'être.
Pascal
"MichDenis" a écrit dans le message de news:
%Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel
2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
La procédure ne requiert aucune référence particulière.
Seulement un copier-coller est suffisant...
As-tu fais (peux-tu) les mises à jour disponibles sur le site
de Microsoft de ta version d'Excel ?
Au delà de ça, je ne peux rien d'autre pour toi.
"pb" <pb@nospam.fr> a écrit dans le message de groupe de discussion :
O#RMoTcFKHA.3932@TK2MSFTNGP04.phx.gbl...
Bonjour MichDenis,
Je dois réellement merder quelque part.
J'ai collé ton code dans un module standard et rien ne se passe.
C'est 2007 ou moi qui déconne.
Ou alors j'ai une référence VBA manquante
Ou ma version d'excel en evaluation ne prends pas en charge certaines
fonctionnalités.
Que ce soient tes codes, ceux de Laurent Longre, ou Walkenbach, aucuns ne
fonctionnent ici
Et il faut réellement que j'inhbibe ou masque ces boutons, sinon l'appli
n'a
plus lieu d'être.
Pascal
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
%23EAFz3bFKHA.4732@TK2MSFTNGP04.phx.gbl...
Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" <pb@nospam.fr> a écrit dans le message de groupe de discussion :
OiXWRqZFKHA.3392@TK2MSFTNGP02.phx.gbl...
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel
2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
La procédure ne requiert aucune référence particulière.
Seulement un copier-coller est suffisant...
As-tu fais (peux-tu) les mises à jour disponibles sur le site
de Microsoft de ta version d'Excel ?
Au delà de ça, je ne peux rien d'autre pour toi.
"pb" a écrit dans le message de groupe de discussion :
O#
Bonjour MichDenis,
Je dois réellement merder quelque part.
J'ai collé ton code dans un module standard et rien ne se passe.
C'est 2007 ou moi qui déconne.
Ou alors j'ai une référence VBA manquante
Ou ma version d'excel en evaluation ne prends pas en charge certaines
fonctionnalités.
Que ce soient tes codes, ceux de Laurent Longre, ou Walkenbach, aucuns ne
fonctionnent ici
Et il faut réellement que j'inhbibe ou masque ces boutons, sinon l'appli
n'a
plus lieu d'être.
Pascal
"MichDenis" a écrit dans le message de news:
%Bonjour Pb,
Essaie ceci :
'1 - Enlève les boutons et inhibe le bouton de fermeture de l'application
'2 - Fait disparaître le menus de l'icône excel de la barre de titre
'3 - La barre de titre demeure toujours présente.
'4 - Pour tout masquer, exécuter la procédure :
' Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
'5 - Pour remettre tout en place, Exécuter la procédure :
' Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
'6 - Et pour empêcher le redimensionnement de la feuille de calcul,
'il y a toujours la commande :
'Menu / outils / Protéger le classeur / fenêtre
Private Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, _
ByVal lpWindowName As String) As Long
Private Declare Function GetClassLong Lib "user32" _
Alias "GetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long) As Long
Private Declare Function SetClassLong Lib "user32" _
Alias "SetClassLongA" _
(ByVal hWnd As Long, _
ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Declare Function GetSystemMenu Lib "user32" (ByVal hWnd As Long, _
ByVal bRevert As Integer) As Integer
Declare Function DeleteMenu Lib "user32" (ByVal hMenu As Integer, _
ByVal nPosition As Integer, ByVal wFlags As Integer) As Integer
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hWnd As Long, ByVal nIndex As Long) _
As Long
Const WS_MINIMIZEBOX = &H20000
Const WS_MAXIMIZEBOX = &H10000
Const GWL_STYLE = (-16)
Sub Disable_Control()
Dim X As Integer
For X = 1 To 9
Call DeleteMenu(GetSystemMenu(Application.hWnd, False), 0, 1024)
Next X
End Sub
Sub RestoreSystemMenu()
hMenu% = GetSystemMenu(Application.hWnd, 1)
End Sub
Sub HideMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = L And Not (WS_MINIMIZEBOX)
L = L And Not (WS_MAXIMIZEBOX)
L = SetWindowLong(Application.hWnd, GWL_STYLE, L)
End Sub
Sub RestoreMinimizeAndMaximizeButtons()
Dim L As Long
L = GetWindowLong(Application.hWnd, GWL_STYLE)
L = SetWindowLong(Application.hWnd, GWL_STYLE, WS_MINIMIZEBOX _
Or WS_MAXIMIZEBOX Or L)
End Sub
Sub RestaureLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub EnleveLaCroix()
Dim LeHandleExcel As Long
Const GCL_STYLE = (-26)
Const CS_NOCLOSE = &H200
LeHandleExcel = FindWindowA("XLMAIN", Application.Caption)
SetClassLong LeHandleExcel, GCL_STYLE, _
GetClassLong(LeHandleExcel, GCL_STYLE) _
Xor CS_NOCLOSE
End Sub
Sub ProcedureGeneral_EnleverLesBoutons_Et_Commandes()
Call Disable_Control
Call HideMinimizeAndMaximizeButtons
Call EnleveLaCroix
End Sub
Sub ProcedureGeneral_RemettreLesBoutons_Et_Commandes()
Call RestoreSystemMenu
Call RestoreMinimizeAndMaximizeButtons
Call RestaureLaCroix
End Sub
"pb" a écrit dans le message de groupe de discussion :
Bonjour,
Sous Xp Pro pourquoi ce code fonctionne en excel 2003 et pas en Excel
2007
Merci
Pascal
Option Explicit
Private Declare Function DeleteMenu Lib "user32" (ByVal _
hMenu As Long, ByVal
nPosition As Long, _
ByVal wFlags As Long) As
Long
Private Declare Function GetSystemMenu Lib "user32" (ByVal _
hwnd As Long, ByVal
bRevert As Long) As Long
Private Declare Function GetWindowLong Lib "user32" Alias _
"GetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long) As Long
Private Declare Function SetWindowLong Lib "user32" Alias _
"SetWindowLongA" (ByVal hwnd As
Long,
ByVal _
nIndex As Long, ByVal dwNewLong As Long) As Long
Private Const GWL_STYLE = (-16)
Private Const MF_BYCOMMAND = &H0&
Private Const MF_BYPOSITION = &H400
Private Const SC_MINIMIZE = &HF020
Private Const SC_MAXIMIZE = &HF030
Private Const SC_CLOSE = 6
Private Const WS_MAXIMIZEBOX = &H10000
Private Const WS_MINIMIZEBOX = &H20000
Private Sub no_x()
' Désactiver X
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_CLOSE, MF_BYPOSITION)
End Sub
Private Sub no_min()
' Désactiver 'minimiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MINIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MINIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub no_max()
' Désactiver 'maximiser'
Dim hMenu As Long, k As Long
hMenu = GetSystemMenu(hwnd, False)
k = DeleteMenu(hMenu, SC_MAXIMIZE, MF_BYCOMMAND)
k = GetWindowLong(hwnd, GWL_STYLE)
k = k Xor WS_MAXIMIZEBOX
SetWindowLong hwnd, GWL_STYLE, k
End Sub
Private Sub Form_Load()
no_x
no_min
no_max
End Sub
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
Je te le répète, je n'ai pas eu le temps de faire le tour
de la question concernant le ruban. Je t'ai donné
l'adresse de Ron de Bruin sur le sujet.
Mais si tu veux masquer complètement le ruban, tu peux
utiliser ceci :
'-----------------------------------------
Sub test()
'Masque tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
'Affiche tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub
'-----------------------------------------
"pb" a écrit dans le message de groupe de discussion :
e$
Les mises à jour ne sont pas complétes par contre, ton code inhibe
l'action
de la croix masque le bouton minimiser.
J'attends que les mises à jour soient complétes et je te tiens au courant.
Dernière question, existe t'il une manip avec les API pour marquer le
bouton
Office (le petit rond en haut à gauche)
Pascal
"MichDenis" a écrit dans le message de news:| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
Je te le répète, je n'ai pas eu le temps de faire le tour
de la question concernant le ruban. Je t'ai donné
l'adresse de Ron de Bruin sur le sujet.
Mais si tu veux masquer complètement le ruban, tu peux
utiliser ceci :
'-----------------------------------------
Sub test()
'Masque tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
'Affiche tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub
'-----------------------------------------
"pb" <pb@nospam.fr> a écrit dans le message de groupe de discussion :
e$3oyAdFKHA.4608@TK2MSFTNGP02.phx.gbl...
Les mises à jour ne sont pas complétes par contre, ton code inhibe
l'action
de la croix masque le bouton minimiser.
J'attends que les mises à jour soient complétes et je te tiens au courant.
Dernière question, existe t'il une manip avec les API pour marquer le
bouton
Office (le petit rond en haut à gauche)
Pascal
"MichDenis" <michdenis@hotmail.com> a écrit dans le message de news:
u2tGiqcFKHA.1488@TK2MSFTNGP03.phx.gbl...
| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...
Je te le répète, je n'ai pas eu le temps de faire le tour
de la question concernant le ruban. Je t'ai donné
l'adresse de Ron de Bruin sur le sujet.
Mais si tu veux masquer complètement le ruban, tu peux
utiliser ceci :
'-----------------------------------------
Sub test()
'Masque tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"
'Affiche tout le ruban
Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",True)"
End Sub
'-----------------------------------------
"pb" a écrit dans le message de groupe de discussion :
e$
Les mises à jour ne sont pas complétes par contre, ton code inhibe
l'action
de la croix masque le bouton minimiser.
J'attends que les mises à jour soient complétes et je te tiens au courant.
Dernière question, existe t'il une manip avec les API pour marquer le
bouton
Office (le petit rond en haut à gauche)
Pascal
"MichDenis" a écrit dans le message de news:| C'est pas parce que je suis en version d'évaluation??
Je ne pense pas...