Discussion :

[ThSPB]

Bonjour à toutes et tous.
Je suis en train de travailler sur un fichier pour un certain nombre de collègues. Les renseignements se font par le biais d'un formulaire (Userform). Ce que je souhaite c'est que ces utilisateurs ne puissent pas accéder aux feuilles de données et calculs (9).
Dans un premier temps j'ai mis le formulaire en plein écran avec ajustement automatique mais la solution n'est pas totalement satisfaisante car ;
‐ si l'on utilise un double écran il suffit de faire glisser l'Userform pour accéder à ces feuilles
‐ ou il suffit de cliquer sur la croix en haut à droite
Il y a la possibilité de masquer les feuilles, mais pour que les macros fonctionnent il faut les ouvrir puis les fermer, plutôt une source d'oublis donc de bugs.
Existe-t-il un moyen de contourner ces difficultés ?
Peut on neutraliser le fonctionnement de la croix en haut à droite ?
Merci pour votre aide

[Philippe PONS]

Bonjour,

voila une procédure qui enlève la croix rouge.
Tu lui pas la référence de ton UserForm en argument.
Si ton UserForm a sa propriété ShowModal=True, les utilisateurs ne peuvent pas
accéder aux feuilles de calcul.
Cordialement,

Code :

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

1
2
3
4
5
6
7
8
Sub enleveCroix(UF As UserForm)
Dim hwnd As Long
    'Enlève la croix rouge de l'UF,pour empêcher sa fermeture
    hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", UF.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
 
End Sub

[ThSPB]

Bonjour et Merci,
mais j'ai un bug, FindWindowA s'affiche en bleu, même après avoir remplacé "Thunder" par "fondTLK" (nom de mon USF)

[Philippe PONS]

Oui, j'ai oublié de coller les déclarations des api!!
Ca devrait mieux marcher!!

NB: les declare function sont à mettre en en-tête de 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
 
Declare Function GetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long) As Long
 
 Declare Function SetWindowLongA Lib "user32" _
(ByVal hwnd As Long, ByVal nIndex As Long, _
ByVal dwNewLong As Long) As Long
 
 Declare Function FindWindowA Lib "user32" _
(ByVal lpClassName As String, ByVal lpWindowName As String) As Long
 
 
Sub enleveCroix(UF As UserForm)
Dim hwnd As Long
    'Enlève la croix rouge de l'UF,pour empêcher sa fermeture
    hwnd = FindWindowA("Thunder" & IIf(Application.Version Like "8*", "X", "D") _
    & "Frame", UF.Caption)
    SetWindowLongA hwnd, -16, GetWindowLongA(hwnd, -16) And &HFFF7FFFF
 
End Sub

[eriiic]

Bonjour,

une méthode radicale à condition d'accepter les contraintes : l'enregistrer en .xlam
Par contre dès que tu t'adresses au classeur il faut le spécifier avec ThisWorkbook.
eric

[ThSPB]

Re-Bonjour,
Excuse mais je suis un peu, pas mal lourd aujourd'hui.
A quoi correspond ;
- "Thunder"
- "8*", "X", "D"
- "Frame"
car du coup j'ai toute la partie "hwnd = FindWindowA("FondTLK" & IIf(Application.Version Like "8*", "X", "D") _
& "Frame", UF.Caption)" surlignée en jaune