Verrouiller double click

**jimmy59270** · 29/01/2019, 13h05

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

**patricktoulon** · 29/01/2019, 13h51

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

Code :

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

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 :

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
 
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

**MarcelG** · 29/01/2019, 14h19

Bonjour Patrick,

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

La toute première fois.

Pour l'affichage normal, survient une erreur

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

sur cette ligne

Code :

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

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

Ensuite, la bascule fonctionne bien.

Y a-t-il un moyen de gérer cette première erreur?

**jimmy59270** · 29/01/2019, 14h44

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

**patricktoulon** · 29/01/2019, 14h44

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 :

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

 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
Nom : Capture.JPG
Affichages : 674
Taille : 107,3 Ko