Discussion :

[kyasteph]

bonjour,
J'ai un classeur partagé , qui s'ouvre sur une page "Accueil" (et les onglets du classeur sont cachés).Sur cette feuille de calcul se trouve le menu listant les différents onglets du classeur et on y accède par des liens hypertextes.
Voici mes préoccupations:
1)Je souhaiterais créer des utilisateurs avec "login" et "mot de passe" pour pouvoir accéder au classeur;
2)Aussi est il possible en fonction de l'utilisateur lui octroyer les onglets "auxquels il a droit" (en clair désactiver les liens hypertexte des onglets qu'on souhaite rendre invisibles)

Quelqu'un a t il la solution à mon problème? merci de m'aider.

[EngueEngue]

Oui c'est faisable il suffira de faire une liste des utilisateurs qui ont droit à certains onglets et de tester dans un worksheet_change

[kyasteph]

Bonjour,
Merci pour votre réponse,je suis heureux que cela soit faisable.Mais comment faire ça: "il suffira de faire une liste des utilisateurs qui ont droit à certains onglets ".Je ne sais vraiment comment m'y prendre. J'ai essayé avec "Application.InputBox" mais je n'arrive pas.
Il faut que tous les onglets auquel n'a pas droit un utilisateur soient en "veryhiden"
Veuillez m'aider s'il vous plait.

[casefayere]

Bonsoir,
Une idée comme une autre, avant d'essayer, je te préviens qu'il faudra protéger ton accès aux macros par mot de passe, ci-dessous ma proposition à adapter :

Dans un module, tu déclares tes utilisateurs et leurs mots de passe, je répête, à toi d'adapter :

Code :

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

1
2
3
Public Const Ut1 As String = "toto", Mdp1 As String = "111"
Public Const Ut2 As String = "titi", Mdp2 As String = "222"
Public Const Ut3 As String = "tata", Mdp3 As String = "333"

dans ThisWorkBook :

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
Option Explicit
Option Base 1
Dim Utilisateur As String, TbNom, x As Integer, Sh As Worksheet, TbMdp
Dim LeCode As String, Mdp As String
 
Private Sub Workbook_Open()
Sheets("accueil").Activate
x = 0
For Each Sh In Worksheets
  If Sh.Name <> "accueil" Then
    x = x + 1
    Range("A" & x) = Sh.Name
  End If
Next Sh
TbNom = Array(Ut1, Ut2, Ut3)
TbMdp = Array(Mdp1, Mdp2, Mdp3)
Utilisateur = InputBox("Veuillez entrer Votre identifiant", "LOGIN")
For x = 1 To UBound(TbNom)
  If TbNom(x) = Utilisateur Then
    LeCode = TbMdp(x)
    Exit For
  ElseIf x = 4 Then
    MsgBox "Vous ne pouvez pas utiliser les liens"
    Exit Sub
  End If
Next x
For x = 1 To 4
  If x = 4 Then Exit For
  Mdp = InputBox("Veuillez entrer Votre mot de passe", "CODE SECRET")
  If Mdp <> LeCode Then
    MsgBox "le code ne correspond pas à l'utilisateur" & Chr(10) & "ATTENTION !, vous avez 3 essais"
  Else
    If Utilisateur = Ut1 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A3"), Address:="", SubAddress:= _
        "Feuil4!A1", TextToDisplay:=Sheets("Feuil4").Name
    ElseIf Utilisateur = Ut2 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:="", SubAddress:= _
        "Feuil3!A1", TextToDisplay:=Sheets("Feuil3").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), Address:="", SubAddress:= _
        "Feuil5!A1", TextToDisplay:=Sheets("Feuil5").Name
    ElseIf Utilisateur = Ut3 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A5"), Address:="", SubAddress:= _
        "Feuil6!A1", TextToDisplay:=Sheets("Feuil6").Name
    End If
    Exit For
  End If
Next x
End Sub

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim dl As Integer
With Sheets("accueil")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A1:A" & dl).Clear
End With
For Each Sh In Worksheets
  If Sh.Name <> "accueil" Then
    Sh.Visible = False
  End If
Next Sh
 
End Sub

Ca vaut ce que ca vaut mais ça te donnera peut-être des idées

Bonne continuation

[EngueEngue]

Si tu connais les machines de l'utilisateur... Tu peux tester le username ou le HDserialName au début et supprimer les onglets auxquels ils n'ont pas droit avec un select case.

[kyasteph]

Bonjour,
Veuillez m'excusez pour ce long silence car absent.
j'ai essayé le code que vous m'avez proposé mais l'erreur suivante "Erreur de compilation dans le module caché:ThisWorkbook" s'affiche à l'ouverture du classeur.
Voici le 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
84
85
86
87
88
89
90
Option Explicit
Option Base 1
Dim Utilisateur As String, TbNom, x As Integer, Sh As Worksheet, TbMdp
Dim LeCode As String, Mdp As String
 
Private Sub Workbook_Open()
 
 
Application.Caption = "PCE  Devxl & Consulting"
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
 
Application.DisplayFormulaBar = False
Application.CommandBars("Control Toolbox").Controls(1).Enabled = False
Application.CommandBars("Visual Basic").Enabled = False
 
    Application.DisplayAlerts = False
    Sheets("Acceuil").Activate
    Application.DisplayAlerts = False
 
x = 0
For Each Sh In Worksheets
  If Sh.Name <> "Acceuil" Then
    x = x + 1
    Range("A" & x) = Sh.Name
  End If
Next Sh
TbNom = Array(Ut1, Ut2, Ut3)
TbMdp = Array(Mdp1, Mdp2, Mdp3)
Utilisateur = InputBox("Veuillez entrer Votre identifiant", "LOGIN")
For x = 1 To UBound(TbNom)
  If TbNom(x) = Utilisateur Then
    LeCode = TbMdp(x)
    Exit For
  ElseIf x = 4 Then
    MsgBox "Vous ne pouvez pas utiliser les liens"
    Exit Sub
  End If
Next x
For x = 1 To 4
  If x = 4 Then Exit For
  Mdp = InputBox("Veuillez entrer Votre mot de passe", "CODE SECRET")
  If Mdp <> LeCode Then
    MsgBox "le code ne correspond pas à l'utilisateur" & Chr(10) & "ATTENTION !, vous avez 3 essais"
  Else
    If Utilisateur = Ut1 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A3"), Address:="", SubAddress:= _
        "Feuil4!A1", TextToDisplay:=Sheets("Feuil4").Name
    ElseIf Utilisateur = Ut2 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:="", SubAddress:= _
        "Feuil3!A1", TextToDisplay:=Sheets("Feuil3").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), Address:="", SubAddress:= _
        "Feuil5!A1", TextToDisplay:=Sheets("Feuil5").Name
    ElseIf Utilisateur = Ut3 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A5"), Address:="", SubAddress:= _
        "Feuil6!A1", TextToDisplay:=Sheets("Feuil6").Name
    End If
    Exit For
  End If
Next x
End Sub
 
 
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    If SaveAsUI = True Then Cancel = True
 
 
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not flag Then Cancel = True
Dim dl As Integer
With Sheets("Acceuil")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A1:A" & dl).Clear
End With
For Each Sh In Worksheets
  If Sh.Name <> "Acceuil" Then
    Sh.Visible = False
  End If
Next Sh
 
End Sub

merci de m'aider.

[casefayere]

sans controler cette partie, je la corrigerais un minimum :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Application.Caption = "PCE  Devxl & Consulting"
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
 
Application.DisplayFormulaBar = False
Application.CommandBars("Control Toolbox").Controls(1).Enabled = False
Application.CommandBars("Visual Basic").Enabled = False
 
    Application.DisplayAlerts = False
    Sheets("Acceuil").Activate
    Application.DisplayAlerts = False
    '......

Code :

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

1
2
3
Application.DisplayAlerts = False
    Sheets("Acceuil").Activate 'vérifies le nom "Acceuil" =>"Accueil"
    Application.DisplayAlerts = True 'et non False

idem ici

Code :

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

1
2
3
4
5
6
For Each Sh In Worksheets
  If Sh.Name <> "Acceuil" Then'nom à vérifier "Accueil"
    x = x + 1
    Range("A" & x) = Sh.Name
  End If
Next Sh

[kyasteph]

Bonjour,
j'ai fait les corrections que vous m'avez apportées mais le résultat est toujours le meme;l'erreur:"erreur de compilation" s'affiche toujours.
voici le 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
84
85
86
87
88
89
90
Option Explicit
Option Base 1
Dim Utilisateur As String, TbNom, x As Integer, Sh As Worksheet, TbMdp
Dim LeCode As String, Mdp As String
 
Private Sub Workbook_Open()
 
 
Application.Caption = "PCE  Devxl & Consulting"
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
 
Application.DisplayFormulaBar = False
Application.CommandBars("Control Toolbox").Controls(1).Enabled = False
Application.CommandBars("Visual Basic").Enabled = False
 
    Application.DisplayAlerts = False
    Sheets("Acceuil").Activate
    Application.DisplayAlerts = True
 
x = 0
For Each Sh In Worksheets
  If Sh.Name <> "Acceuil" Then
    x = x + 1
    Range("A" & x) = Sh.Name
  End If
Next Sh
TbNom = Array(Ut1, Ut2, Ut3)
TbMdp = Array(Mdp1, Mdp2, Mdp3)
Utilisateur = InputBox("Veuillez entrer Votre identifiant", "LOGIN")
For x = 1 To UBound(TbNom)
  If TbNom(x) = Utilisateur Then
    LeCode = TbMdp(x)
    Exit For
  ElseIf x = 4 Then
    MsgBox "Vous ne pouvez pas utiliser les liens"
    Exit Sub
  End If
Next x
For x = 1 To 4
  If x = 4 Then Exit For
  Mdp = InputBox("Veuillez entrer Votre mot de passe", "CODE SECRET")
  If Mdp <> LeCode Then
    MsgBox "le code ne correspond pas à l'utilisateur" & Chr(10) & "ATTENTION !, vous avez 3 essais"
  Else
    If Utilisateur = Ut1 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A3"), Address:="", SubAddress:= _
        "Feuil4!A1", TextToDisplay:=Sheets("Feuil4").Name
    ElseIf Utilisateur = Ut2 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:="", SubAddress:= _
        "Feuil3!A1", TextToDisplay:=Sheets("Feuil3").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), Address:="", SubAddress:= _
        "Feuil5!A1", TextToDisplay:=Sheets("Feuil5").Name
    ElseIf Utilisateur = Ut3 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A5"), Address:="", SubAddress:= _
        "Feuil6!A1", TextToDisplay:=Sheets("Feuil6").Name
    End If
    Exit For
  End If
Next x
End Sub
 
 
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    If SaveAsUI = True Then Cancel = True
 
 
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not flag Then Cancel = True
Dim dl As Integer
With Sheets("Acceuil")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A1:A" & dl).Clear
End With
For Each Sh In Worksheets
  If Sh.Name <> "Acceuil" Then
    Sh.Visible = False
  End If
Next Sh
 
End Sub

Merci de m'aider.

[casefayere]

Bonjour,
toujours la même erreur :

Code :

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

Sheets("Acceuil").Activate

à moins que tu n'ais décidé de nommer ta feuille avec une faute d'ortographe !

acceuil (non) => accueil (oui)

[kyasteph]

Bonjour,
Je ne pense pas que ce soit le nom qui pose probleme(à mon avis il poserait probleme si ce n'était le meme qui était repété dans le code).
Mais j'ai tout de meme effectué la correction mais la meme erreur apparait.
Avez vous une idée d'ou peut venir le probleme?
merci d'avance.
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
84
85
86
87
88
89
90
Option Explicit
Option Base 1
Dim Utilisateur As String, TbNom, x As Integer, Sh As Worksheet, TbMdp
Dim LeCode As String, Mdp As String
 
Private Sub Workbook_Open()
 
 
Application.Caption = "PCE  Devxl & Consulting"
    ActiveWindow.DisplayHorizontalScrollBar = False
    ActiveWindow.DisplayVerticalScrollBar = False
 
Application.DisplayFormulaBar = False
Application.CommandBars("Control Toolbox").Controls(1).Enabled = False
Application.CommandBars("Visual Basic").Enabled = False
 
    Application.DisplayAlerts = False
    Sheets("Accueil").Activate
    Application.DisplayAlerts = True
 
x = 0
For Each Sh In Worksheets
  If Sh.Name <> "Accueil" Then
    x = x + 1
    Range("A" & x) = Sh.Name
  End If
Next Sh
TbNom = Array(Ut1, Ut2, Ut3)
TbMdp = Array(Mdp1, Mdp2, Mdp3)
Utilisateur = InputBox("Veuillez entrer Votre identifiant", "LOGIN")
For x = 1 To UBound(TbNom)
  If TbNom(x) = Utilisateur Then
    LeCode = TbMdp(x)
    Exit For
  ElseIf x = 4 Then
    MsgBox "Vous ne pouvez pas utiliser les liens"
    Exit Sub
  End If
Next x
For x = 1 To 4
  If x = 4 Then Exit For
  Mdp = InputBox("Veuillez entrer Votre mot de passe", "CODE SECRET")
  If Mdp <> LeCode Then
    MsgBox "le code ne correspond pas à l'utilisateur" & Chr(10) & "ATTENTION !, vous avez 3 essais"
  Else
    If Utilisateur = Ut1 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A3"), Address:="", SubAddress:= _
        "Feuil4!A1", TextToDisplay:=Sheets("Feuil4").Name
    ElseIf Utilisateur = Ut2 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A2"), Address:="", SubAddress:= _
        "Feuil3!A1", TextToDisplay:=Sheets("Feuil3").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A4"), Address:="", SubAddress:= _
        "Feuil5!A1", TextToDisplay:=Sheets("Feuil5").Name
    ElseIf Utilisateur = Ut3 Then
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A1"), Address:="", SubAddress:= _
        "Feuil2!A1", TextToDisplay:=Sheets("Feuil2").Name
      ActiveSheet.Hyperlinks.Add Anchor:=Range("A5"), Address:="", SubAddress:= _
        "Feuil6!A1", TextToDisplay:=Sheets("Feuil6").Name
    End If
    Exit For
  End If
Next x
End Sub
 
 
 
 
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
 
    If SaveAsUI = True Then Cancel = True
 
 
End Sub
 
Private Sub Workbook_BeforeClose(Cancel As Boolean)
If Not flag Then Cancel = True
Dim dl As Integer
With Sheets("Accueil")
  dl = .Range("A" & .Rows.Count).End(xlUp).Row
  .Range("A1:A" & dl).Clear
End With
For Each Sh In Worksheets
  If Sh.Name <> "Accueil" Then
    Sh.Visible = False
  End If
Next Sh
 
End Sub