Discussion :

[NEC14]

Bonjour,

J'ai tapé le code ci-dessous qui me permet, lorsque je clique dans une cellule, l'ouverture d'un formulaire. Lors du premier clic, il me demande un mot de passe. Mais dans l'état actuel, il me demande le mot de passe à chaque clic.
Pouvez-vous me dire où j'ai fait une erreur et si vous pouvez m'aider ?
Merci par avance

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
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim Col As Long
    Dim Lig As Long
    Dim A As Long
    Dim Vpasse As Long
    Vpasse = Val(InputBox("Mot de passe ?"))
    If Vpasse < 6100 Then Exit Sub
    If Vpasse = 6100 Then
        If Intersect(Range("ZO1"), ActiveCell) Is Nothing Then Exit Sub
        If IsEmpty(ActiveCell.Value) Then
            Lig = 6
            Col = ActiveCell.Column
            A = Cells(Lig, Col).Value
            If A = 0 Then Col = Col - 1
            If Weekday(Cells(Lig, Col).Value) <> 1 And Weekday(Cells(Lig, Col).Value) <> 7 Then
                Load FrmAbs
                FrmAbs.Show
            End If
        End If
    End If
    Exit Sub
End Sub

[lucfrfr]

Bonjour,
Il est tout à fais normal qu'il te demande un mdp à chaque fois, car si ta fonction est

Code :

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

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

Alors à chaque fois que tu cliqueras ou utiliseras les flèches pour changer, tu auras la demande de mdp.

[NEC14]

Bonjour,

Et comment résoudre ce problème ?
Merci

[random]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim flag As Boolean
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim motpasse As String
If Not flag Then
Do
motpasse = InputBox("motpasse")
Loop Until motpasse = "BEURK"
flag = True
End If
End Sub

[lucfrfr]

Oui c'est ca lol
c'est le genre que je voulais mettre mais j'avais un doute sur l'execution.

[NEC14]

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Dim flag As Boolean
 
 
Private Sub Worksheet_Change(ByVal Target As Range)
Dim motpasse As String
If Not flag Then
Do
motpasse = InputBox("motpasse")
Loop Until motpasse = "BEURK"
flag = True
End If
End Sub

Bonjour,
Mais je garde quand même le reste du code ???
Merci

[random]

ben oui

[NEC14]

Je suis débutant en la matière et ce n'est pas toujours évident.
J'essaie et je te tiens au courant.
A++

[NEC14]

Donc mon nouveau code est comme ça :

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
Dim Flag As Boolean
Private Sub Worksheet_Change(ByVal Target As Range)
Dim motpasse As String
If Not Flag Then
Do
motpasse = Inputbox("Taper le mot de passe")
Loop Until motpasse = "6100"
Flag = True
End If
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim Col As Long
Dim Lig As Long
Dim A As Long
    If Intersect(Range("ZO1"), ActiveCell) Is Nothing Then Exit Sub
    If IsEmpty(ActiveCell.Value) Then
Lig = 6
Col = ActiveCell.Column
A = Cells(Lig, Col).Value
    If A = 0 Then Col = Col - 1
    If Weekday(Cells(Lig, Col).Value) <> 1 And Weekday(Cells(Lig, Col).Value) <> 7 Then
Load FrmAbs
FrmAbs.Show
    End If
 End If
End Sub