xRay13
Messages postés14Date d'inscriptionmercredi 23 janvier 2008StatutMembreDernière intervention30 septembre 2009
-
16 avril 2008 à 11:55
xRay13
Messages postés14Date d'inscriptionmercredi 23 janvier 2008StatutMembreDernière intervention30 septembre 2009
-
18 avril 2008 à 07:53
Bonjour,
j'utilise une macro qui me permet d'afficher la liste des onglets de mon fichier en menu contextuel sur click droit et je souhaiterai la faire évoluer pour etre en mesure de ne pas tout afficher pour tout le monde ou au moins de filter l'acces à certains choix par un mot de passe.
Public I&
Const NomMenu As String = "ListeFeuilles"
Sub ActiveF(I& )
ThisWorkbook.Worksheets(I).Select
End Sub
--------------------------------------------------------------------------------
Sub Effclick()
On Error Resume Next
Application.CommandBars("cell" ).Controls.Item(NomMenu).Delete
End Sub
--------------------------------------------------------------------------------
Sub Princ()
With Application.CommandBars("cell" ).Controls.Add(msoControlPopup, , , 1, True)
.Caption = NomMenu
.OnAction = "AjoutListeF"
End With
End Sub
--------------------------------------------------------------------------------
Private Sub AjoutListeF()
Dim C As CommandBarPopup
Set C = Application.CommandBars("cell" ).Controls(NomMenu)
For I = C.Controls.Count To 1 Step -1
C.Controls(I).Delete
Next I
For I = 1 To ThisWorkbook.Worksheets.Count
If Sheets(I).Visible Then
With C.Controls.Add(msoControlButton)
.Caption = Sheets(I).Name
If .Caption = "Sheet1" Then
.BeginGroup = True
ElseIf .Caption = "Sheet2" Then
.BeginGroup = True
ElseIf .Caption = "sheet3" Then
.BeginGroup = True
ElseIf .Caption = "Sheet4" Then
.FaceId = 419
.BeginGroup = True
ElseIf .Caption = "Sheet5" Then
.FaceId = 362
End If
.OnAction = "'ActiveF """ & I & """'"
End With
End If
Next I
End Sub
Je voudrais par exemple limiter l'acces à la "Sheet3" à l'administrateur du fichier.
Si quelqu'un peut m'aider ..... ?
Merci d'avance
A voir également:
Filtrage acces menu contextuel par profil utilisateur
bigfish_le vrai
Messages postés1835Date d'inscriptionvendredi 13 mai 2005StatutMembreDernière intervention20 novembre 201315 17 avril 2008 à 20:28
Salut,
evidemment je ne sais pas comment est structuré ton fichier mais ce que je te propose : c'est d'afficher la sheet3 quand admin est ecrit dans la cellule A1 d'une autre feuille de ton ton choix. Le mieux c'est que ce soit une feuille protégé par mot de passe pour que la cellule A1 ne puisse pas etre modifiée quand cette feuille est protégée.
Private Sub Worksheet_Change(ByVal Target As Range)
With Target If .Columns.Count 1 And .Rows.Count 1 Then ' in order to prevent the multi cells selection If Target.Address "$A$1" And LCase(Target.Value) "admin" Then 'ici tu peux enlever le Lcase si tu veux que la casse soit respecté
Sheets("sheet3").Visible = True 'on affiche la feuille
Sheets("summary").Unprotect 'ici la feuille dans la quelle tu as placé ce code sur la quelle on enleve la protection ElseIf Target.Address "$A$1" And Not LCase(Target.Value) "admin" Then 'ici tu peux enlever le Lcase si tu veux que la casse soit respecté
Sheets("sheet3").Visible = xlVeryHidden 'on cache la feuille, avec cette methode la feuille n'apparatrat nul par, et ce meme dans la liste du menu : view format sheet
'puis on protege la feuille de la
Worksheets("summary").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
True, AllowFormattingCells:=True, AllowFormattingColumns:=True, _
AllowFormattingRows:=True, AllowInsertingColumns:=True, AllowInsertingRows _
:=True, AllowDeletingColumns:=True, AllowDeletingRows:=True, AllowSorting _
:=True, AllowFiltering:=True
End If
End If
End With
End Sub
Evidemment tu peux remplacer admin par autre chose et choisir une autre cellule que la cellule A1. Tu peux aussi metre un mot de passe sur le code VBA. Note bien que les mots de passe dans excel ne protege pas grand chose mais sont grandement suffisent pour l'utilisateur moyen. Note aussi que tu n'as pas besoin de connaitre le VBA pour cracker un mot de passe VBA mais que par contre il faudrat comprendre un peu le code que je t'ai donné pour reafiché la feuille sheet3.
Enfin ajoute un bout de code qui efface automatiquement le contenu de la Cellule A1 avant sauvegarde du fichier cela evitera le cas ou l'aministrateur as oublier de l'affacer.
If Sheets("summary").Range("A1").Value <> "" then Sheets("summary").Range("A1").ClearContents
Du fait du code plus haut cette ligne de code dans l'evenement BeforeSave du workbook sera suffisente.