VBA & PVT sur Sheets Protégées & Variable Password

Comment inclure dans le code VBA la possibilité d'utiliser les PVT sur les Sheets protégées

Bonjour,

Je rencontre deux problèmes que j'aimerai solutionner, je ne suis pas encore un expert comme vous :-)

1. J'ai inséré un code VBA dans mon Workbook afin de protéger ou pas différentes Sheets selon les droits utilisateurs, problème sur les feuilles protégés, on ne sait plus utiliser les slicers!

2. J'aimeria installer une variable dans le code afin de remplacer tous les mots de passes "1234"

VBA code :

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

Dim column_count As Integer
column_count = Application.WorksheetFunction.CountA(Range("2:2"))

If Target.Column >= 4 Then
If Cells(2, Target.Column).Value <> "" And Cells(Target.Row, 1) <> "" Then
If Target.Value = "x" Then
Target.Value = "Ï"
ElseIf Target.Value = "Ï" Then
Target.Value = "Ð"
ElseIf Target.Value = "Ð" Then
Target.Value = "x"
Else
Target.Value = "x"
End If

End If

' Apply same as all

If Target.Column = 4 Then
Range("E" & Target.Row, Cells(Target.Row, column_count)).Value = Target.Value
End If

End If

End Sub

Private Sub CommandButton1_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Rights")

If Me.Txt_UserName.Value = "" Then
MsgBox "Please enter your user name", vbCritical
Exit Sub
End If

If Me.Txt_Psswd = "" Then
MsgBox "Please enter your password", vbCritical
Exit Sub
End If

If Application.WorksheetFunction.CountIf(sh.Range("A:A"), Me.Txt_UserName.Value) = 0 Then
MsgBox "Invalid user name", vbCritical
Exit Sub
End If

Dim user_row As Integer
user_row = Application.WorksheetFunction.Match(Me.Txt_UserName.Value, sh.Range("A:A"), 0)

If Me.Txt_Psswd.Value <> CStr(sh.Range("C" & user_row).Value) Then
MsgBox "Invalid password", vbCritical
Exit Sub
End If

Dim lock_worksheet, Unlock_worksheet As Integer

lock_worksheet = Application.WorksheetFunction.CountIf(sh.Range("E" & user_row, "XFD" & user_row), "Ï")
Unlock_worksheet = Application.WorksheetFunction.CountIf(sh.Range("E" & user_row, "XFD" & user_row), "Ð")

If (lock_worksheet + Unlock_worksheet) = 0 Then
MsgBox "You don't have access to this Report, please contact the administrator", vbCritical
Exit Sub
End If

' Apply Setting
Dim wsh As Worksheet
Dim i As Integer

If sh.Range("B" & user_row).Value = "Admin" Then 'for Admin Role
sh.Unprotect 1234
sh.Cells.EntireColumn.Hidden = False
sh.Cells.EntireRow.Hidden = False

ThisWorkbook.Unprotect 1234
For Each wsh In ThisWorkbook.Worksheets
wsh.Visible = xlSheetVisible
wsh.Unprotect 1234
Next wsh

ActiveWindow.DisplayWorkbookTabs = True

Else 'for Users

ThisWorkbook.Unprotect 1234
ActiveWindow.DisplayWorkbookTabs = True

For i = 5 To Application.WorksheetFunction.CountA(sh.Range("2:2"))
Set wsh = ThisWorkbook.Sheets(sh.Cells(2, i).Value)

If sh.Cells(user_row, i).Value = "Ð" Then 'for unlock
wsh.Visible = xlSheetVisible
wsh.Unprotect 1234
ElseIf sh.Cells(user_row, i).Value = "Ï" Then 'for unloack
wsh.Visible = xlSheetVisible
wsh.Protect 1234
End If

Next i

ThisWorkbook.Unprotect 1234
sh.Visible = xlSheetVeryHidden

End If

Unload Me

End Sub

Private Sub CommandButton2_Click()

Dim sh As Worksheet
Set sh = ThisWorkbook.Sheets("Rights")

If Me.Txt_UserName.Value = "" Then
MsgBox "Please enter your user name", vbCritical
Exit Sub
End If

If Me.Txt_Psswd = "" Then
MsgBox "Please enter your password", vbCritical
Exit Sub
End If

If Application.WorksheetFunction.CountIf(sh.Range("A:A"), Me.Txt_UserName.Value) = 0 Then
MsgBox "Invalid user name", vbCritical
Exit Sub
End If

Dim user_row As Integer
user_row = Application.WorksheetFunction.Match(Me.Txt_UserName.Value, sh.Range("A:A"), 0)

If Me.Txt_Psswd.Value <> CStr(sh.Range("C" & user_row).Value) Then
MsgBox "Invalid password", vbCritical
Exit Sub
End If

With Frm_Password_Reset
.Txt_UserName.Value = Me.Txt_UserName.Value
.Txt_User_Row.Value = user_row
.Show False

End With

Unload Me

End Sub

Private Sub Txt_UserName_Change()

End Sub

Private Sub UserForm_Activate()

Dim sh As Worksheet
Dim wsh As Worksheet

Set sh = ThisWorkbook.Sheets("Rights")
ThisWorkbook.Unprotect 1234

sh.Visible = xlSheetVisible

For Each wsh In ThisWorkbook.Worksheets
If wsh.Name <> "Rights" Then
wsh.Visible = xlSheetVeryHidden
End If

Next wsh

sh.Unprotect 1234
sh.Cells.EntireColumn.Hidden = True
sh.Cells.EntireRow.Hidden = True
sh.Protect 1234

ThisWorkbook.Protect 1234

ActiveWindow.DisplayWorkbookTabs = False

End Sub

Merci beaucoup de votre aide, cela est très appréciable.

Eric

Bonjoir,

1 - Segments (slicers)

Segment, Taille et propriétés, Propriétés : décocher Verrouillé

2 - Protection feuille

Cocher Utilisation des tabalaux croisés dynamiques et ....

3 - Mot de passe

Déclarer une constant PWD, soit :

const PWD="1234"

Remplacer tous les "1234" par PWD.

Cdlt.

Thanks,

Mais je suis pas convaicu de la réponse, je voudrais automatiser dans mon code qui verouille la/les feuilles en fonction des utilisateurs, l'option que nous retrouvons au sein de "Protect Sheet" "Use Pivot Table & PivotChart".

Pas simple...

Merci de votre aide.

Eric

Pour le Psswd je vais essayer, grand merci Jean-Eric de votre aide.

Bonjour,

Pour le PASSWORD , Merci Jean Eric.

Par contre je ne sais pas ou je dois inclure dans le code " AllowUsingPivotTables:=True" afin de pouvoir utiliser les slicers lorsque les feuilles sont protégés.

La protection se fait lors du chargement du code VBA, donc manuellement on a pas accès à l'option de cocher "Tableau & Charts PVT".

Merci de votre aide.

Eric

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim column_count As Integer column_count = Application.WorksheetFunction.CountA(Range("2:2")) If Target.Column >= 4 Then If Cells(2, Target.Column).Value <> "" And Cells(Target.Row, 1) <> "" Then If Target.Value = "x" Then Target.Value = "Ï" ElseIf Target.Value = "Ï" Then Target.Value = "Ð" ElseIf Target.Value = "Ð" Then Target.Value = "x" Else Target.Value = "x" End If End If ' Apply same as all If Target.Column = 4 Then Range("E" & Target.Row, Cells(Target.Row, column_count)).Value = Target.Value End If End If End Sub Private Sub CommandButton1_Click() Dim Sh As Worksheet Set Sh = ThisWorkbook.Sheets("Rights") If Me.Txt_UserName.Value = "" Then MsgBox "Please enter your user name", vbCritical Exit Sub End If If Me.Txt_Psswd = "" Then MsgBox "Please enter your password", vbCritical Exit Sub End If If Application.WorksheetFunction.CountIf(Sh.Range("A:A"), Me.Txt_UserName.Value) = 0 Then MsgBox "Invalid user name", vbCritical Exit Sub End If Dim user_row As Integer user_row = Application.WorksheetFunction.Match(Me.Txt_UserName.Value, Sh.Range("A:A"), 0) If Me.Txt_Psswd.Value <> CStr(Sh.Range("C" & user_row).Value) Then MsgBox "Invalid password", vbCritical Exit Sub End If Dim lock_worksheet, Unlock_worksheet As Integer lock_worksheet = Application.WorksheetFunction.CountIf(Sh.Range("E" & user_row, "XFD" & user_row), "Ï") Unlock_worksheet = Application.WorksheetFunction.CountIf(Sh.Range("E" & user_row, "XFD" & user_row), "Ð") If (lock_worksheet + Unlock_worksheet) = 0 Then MsgBox "You don't have access to this Report, please contact the administrator", vbCritical Exit Sub End If ' Apply Setting Dim wsh As Worksheet Dim i As Integer Pswd = "Vbs8247$" If Sh.Range("B" & user_row).Value = "Admin" Then 'for Admin Role Sh.Unprotect Pswd Sh.Cells.EntireColumn.Hidden = False Sh.Cells.EntireRow.Hidden = False ThisWorkbook.Unprotect Pswd For Each wsh In ThisWorkbook.Worksheets wsh.Visible = xlSheetVisible wsh.Unprotect Pswd Next wsh ActiveWindow.DisplayWorkbookTabs = True Else 'for Users ThisWorkbook.Unprotect Pswd ActiveWindow.DisplayWorkbookTabs = True For i = 5 To Application.WorksheetFunction.CountA(Sh.Range("2:2")) Set wsh = ThisWorkbook.Sheets(Sh.Cells(2, i).Value) If Sh.Cells(user_row, i).Value = "Ð" Then 'for unlock wsh.Visible = xlSheetVisible wsh.Unprotect Pswd ElseIf Sh.Cells(user_row, i).Value = "Ï" Then 'for unloack wsh.Visible = xlSheetVisible wsh.Protect Pswd End If Next i ThisWorkbook.Unprotect Pswd Sh.Visible = xlSheetVeryHidden End If Unload Me End Sub Private Sub CommandButton2_Click() Dim Sh As Worksheet Set Sh = ThisWorkbook.Sheets("Rights") If Me.Txt_UserName.Value = "" Then MsgBox "Please enter your user name", vbCritical Exit Sub End If If Me.Txt_Psswd = "" Then MsgBox "Please enter your password", vbCritical Exit Sub End If If Application.WorksheetFunction.CountIf(Sh.Range("A:A"), Me.Txt_UserName.Value) = 0 Then MsgBox "Invalid user name", vbCritical Exit Sub End If Dim user_row As Integer user_row = Application.WorksheetFunction.Match(Me.Txt_UserName.Value, Sh.Range("A:A"), 0) If Me.Txt_Psswd.Value <> CStr(Sh.Range("C" & user_row).Value) Then MsgBox "Invalid password", vbCritical Exit Sub End If With Frm_ResetPassword .Txt_UserName.Value = Me.Txt_UserName.Value .Txt_UserRow = user_row .Show False End With Unload Me End Sub Private Sub Image1_Click() End Sub Private Sub UserForm_Activate() Dim Sh As Worksheet Dim wsh As Worksheet Set Sh = ThisWorkbook.Sheets("Rights") ThisWorkbook.Unprotect Pswd Sh.Visible = xlSheetVisible For Each wsh In ThisWorkbook.Worksheets If wsh.Name <> "Rights" Then wsh.Visible = xlSheetVeryHidden End If Next wsh Sh.Unprotect Pswd Sh.Cells.EntireColumn.Hidden = True Sh.Cells.EntireRow.Hidden = True Sh.Protect Pswd ThisWorkbook.Protect Pswd ActiveWindow.DisplayWorkbookTabs = False End Sub