Verrouiller double click

Version imprimable

29/01/2019, 12h05
jimmy59270

1 pièce(s) jointe(s)

Verrouiller double click

Bonjour à Tous,

Je suis nouveau sur le site et j'espère que quelqu'un pourra m'aider.

Je me suis un peu débrouiller pour faire ce programme mais je suis de très loin un expert.

Mon dernier petit soucis est le suivant :

Au démarrage, mon fichier démarre en pleine écran et je masque tous les rubans, barre, croix rouge, bouton réduction écran..

Par contre je souhaite aussi qu'il soit impossible de faire un double click afin de réduire la fenêtre et sortir du pleine écran.

j'ai verrouiller l'ensemble de mon fichier mais il reste la partie tous en haut ou il y a le nom du fichier si je fais un double click la fenêtre se réduit et je sors ainsi du plein écran.

Mon programme fait 16mo je n'ai pas pu le mettre en Pj.Je vous ai fait un imprim ecran, vous pouvez voir l'ouverture de mon programme et la ou j'ai surligné en jaune c'est le seul endroit ou il est possible de faire un double click et sortir du full screen et je voudrais empêcher cela.

Pouvez vous m'aider s'il vous plait.

merci d'avance

Bonjour
teste ceci
met deux bouton sur un sheets et dans le module du sheets

Code:

1
2
3
4
5
6
7
8
 
Private Sub CommandButton1_Click()
affichage_plein_ecran
End Sub
'
Private Sub CommandButton2_Click()
affichage_normal
End Sub

et dans un module standard tu va mettre ce code

Code:

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
 
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
    #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
    #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
 
#End If
'
Sub restaurer_croix_sys()
    Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, Application.Caption)
    SetWindowLongA hWnd, -16, &H94CF0080
End Sub
'
'
Sub supprimer_croix_sys()    ' on enleve juste la croix
    Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, Application.Caption)
    SetWindowLongA hWnd, -16, &H94C70080
End Sub
'
'
'
Sub no_caption()
    Dim hWnd As Long
    hWnd = FindWindowA(vbNullString, Application.Caption)
    SetWindowLongA hWnd, -16, &H94080080
End Sub
'
'
'
Sub affichage_normal()
    restaurer_croix_sys
    With Application
        .ScreenUpdating = False
        .DisplayFullScreen = False
        .DisplayFormulaBar = True
        .WindowState = xlMaximized
        .OnKey "{esc}"
    End With
    With ActiveWindow
        .DisplayHeadings = True
        .DisplayGridlines = True
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayWorkbookTabs = True
    End With
    CommandBars.FindControl(ID:=2951).Enabled = True
End Sub
'
'
'
Sub affichage_plein_ecran()
    Application.ScreenUpdating = False
    no_caption    ' enleve tout et plein ecran
    With Application
        .DisplayFullScreen = True
        .ScreenUpdating = True
        .OnKey "{esc}", "roule"
        .DisplayFormulaBar = False
    End With
    With ActiveWindow
        .DisplayHeadings = False
        ' .DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
    CommandBars.FindControl(ID:=2951).Enabled = True    ' on bloque l'item du menu cell"fermer le plein ecran
End Sub
'
Sub roule()
    Dim toto
    toto = "la tete a toto"
End Sub

;)

29/01/2019, 13h19
MarcelG

Bonjour Patrick,

Je me sens dépassé par ce genre de code.

La toute première fois.

Pour l'affichage normal, survient une erreur

Citation:

91 Variable objet ou variable de bloc With non définie

sur cette ligne

Code:

CommandBars.FindControl(ID:=2951).Enabled = True

Ensuite, la bascule fonctionne bien.

Y a-t-il un moyen de gérer cette première erreur?
29/01/2019, 13h44
jimmy59270

parfait

Super un grand merci cela fonctionne très bien :)

je n'ai pas mis les 2 boutons mais j'ai fait une activation a l'ouverture et fermeture du fichier c'est TOP :)

Par contre sais tu me dire comment faire car j'ai la barre jaune qui apparaît : Mode protéger ... activer le contenu.

J'aimerais que cela ne s'affiche sur aucun PC que je vais utiliser le fichier.

Il y a t il un code VBA pour l'activer le contenu directement à l'ouverture du fichier?

merci
29/01/2019, 13h44
patricktoulon

1 pièce(s) jointe(s)

re

Bonjour marcel
oui je l'ai vu apres je sais pas pourquoi ca ne fonctionne plus
le bouton du menu c'est bien le bon "ID:=2951" mais visiblement findcontrol ne le trouve plus
je remplace donc cette ligne par ceci puisque c'est le dernier bouton du menu cell

Code:

With CommandBars("cell"): .Controls(.Controls.Count).Enabled = False: End With ' on débloque l'item du menu cell"fermer le plein ecran

bien sur il faut le remettre a true dans la sub affichage normal meme si il y est pas sinon le prochain fichier ou tu pourrais en avoir besoin n'y aura pas acces

ou tu peux faire simplement commandbars("cell").reset si tu n'y a pas apporté d'autre modification

et voila
Pièce jointe 445566
29/01/2019, 13h54
patricktoulon

1 pièce(s) jointe(s)

re

re

Citation:

Par contre sais tu me dire comment faire car j'ai la barre jaune qui apparaît : Mode protéger ... activer le contenu.

il me semble que ca concerne les parametres de securité ca
Pièce jointe 445580
29/01/2019, 15h38
jimmy59270

Super Merci

merci je met le problème en résolu :)
29/01/2019, 15h53
MarcelG

Salut Patrick,

Ton code est effectif. :ccool:
Dans ce type de gestion, il faut bien veiller à l'affichage lors de l'ouverture comme à la fermeture.
Les collègues clients risqueraient de ne pas comprendre sinon. :)

1 pièce(s) jointe(s)

re
du coup je suis revenus sur ce vieux truc pour comprendre pourquoi en plein ecran j'avais un peu la colonne A de mangée
et en effet quand on passe par displayfullscreen il est impossible de corriger ce detail
alors je suis passer par un autre chemin et j'ai ajouté la memo de l'ancienne posision d'affichage (xlnormal,xlmaximized)

donc j'utilise un autre moyen de shunter le ruban
donc le bouton du menu "fermerle plein ecran" n'apparait pas donc pas besoins de le gerer
et plus besoins non plus de gerer la touche esc

version 2.0 (2019)
dans un module standard

Code:

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
 
'///////////////////////////////////////////////////////////
'Module d'affichage de la grille plein ecran ou fentre
'Auteur: patricktoulon sur developpez.com
'Version 2.0
'date: 29/01/2019
'///////////////////////////////////////////////////////////
#If Win64 Then
    #If VBA7 Then
        Public Declare ptrsafe Function SwL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong 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 DrW Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As Long) As Long
    #ElseIf VBA6 Then
        Public Declare Function SwL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Public Declare Function DrW Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As Long) As Long
    #End If
#Else
    Public Declare Function SwL Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Public Declare Function FindWindowA Lib "user32" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Public Declare Function DrW Lib "user32" Alias "DrawMenuBar" (ByVal hwnd As Long) As Long
#End If
Type appdim: height As Long: width As Long: left As Long: top As Long: state As Long: End Type
Dim mydim As appdim
'
Sub plein_ecran(Optional wstate As Long = xlMaximized)
    no_caption
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",False)"    'donne pas tout a fait le meme resultat que displayfullscreen
    With Application
        '.DisplayFullScreen = True' on ne s'en sert pas
        .ScreenUpdating = False
        .DisplayFormulaBar = False
        .DisplayStatusBar = False
        If .WindowState <> xlMaximized Then
            mydim.top = .top
            mydim.left = .left
            mydim.height = .height
            mydim.width = .width
            mydim.state = xlNormal
        Else
            mydim.state = xlMaximized
        End If
        .WindowState = wstate
    End With
    With ActiveWindow
        .DisplayHeadings = False
        '.DisplayGridlines = False
        .DisplayHorizontalScrollBar = False
        .DisplayVerticalScrollBar = False
        .DisplayWorkbookTabs = False
    End With
End Sub
'
Sub affichage_normale()
    Application.ExecuteExcel4Macro "SHOW.TOOLBAR(""Ribbon"",true)"
    normal
    With Application
        .ScreenUpdating = False
        .DisplayFullScreen = False
        .DisplayFormulaBar = True
        .DisplayStatusBar = True
        If mydim.state = xlNormal Then
            WindowState = xlNormal
            .top = mydim.top
            .left = mydim.left
            .height = mydim.height
            .width = mydim.width
        Else
            .WindowState = xlMaximized
        End If
    End With
    With ActiveWindow
        .DisplayHeadings = True
        .DisplayGridlines = True
        .DisplayHorizontalScrollBar = True
        .DisplayVerticalScrollBar = True
        .DisplayWorkbookTabs = True
    End With
    Application.ScreenUpdating = True
End Sub
'
Sub no_caption()    ' pour enlever la caption
    Handle = FindWindowA(vbNullString, Application.Caption)
    SwL Handle, -16, &H94080080: SwL Handle, -20, &H0:
    DrW Handle
End Sub
'
Sub normal()    'pour remettre la caption
    DrW Handle
    Handle = FindWindowA(vbNullString, Application.Caption)
    SwL Handle, -16, &H94CF0080
End Sub

3 bouton dans une feuille
code dans le module de la feuille

Code:

1
2
3
4
5
6
7
8
9
10
11
12
 
 
Private Sub retour_Click()
affichage_normale
End Sub
 
Private Sub GRILLEFULLSCREEN_Click()
plein_ecran xlMaximized
End Sub
Private Sub onlygrilleinwindow_Click()
plein_ecran xlNormal
End Sub

voila la grille est parfaitement dimentionnée en plein ecran je n'ai plus la partie haute de la ligne 1 et la partie gauche de la colonne "A mangée

30/01/2019, 11h00
MarcelG

Bonjour Patrick,

Je ne vois pas de différence d'action entre les procédures

Code:

plein_ecran xlMaximized

et

Code:

plein_ecran xlNormal

Autrement dit entre le mode fenêtre et le mode plein écran.

L'affichage est en plein écran total pour les 2 cas.
30/01/2019, 11h18
patricktoulon

re

re
bonjour Marcel
non c'est pas pareil
met toi en mode fenetre avec excel (pas maximisé) et teste les deux bouton
entre les deux bien sur cliquer sur retour
30/01/2019, 11h44
MarcelG

Patrick,

J'ai recopié les codes tels quels
Les 2 boutons me donnent, sur Excel 2016, et pour ma configuration, les mêmes résultats.
A l'écran n'apparaissent que les cellules.
Désolé.
Au demeurant, les 2 procédures suffisent à mes besoins.