filtre par password

Merci Eric,

Mais ca bug dés l'ouverture du fichier à cette ligne là :
MotDePasse(1) = "MichD": colcritère(1) = "K:K": critère(1) = "107"
sur le colcritère
il marque erreur de compilation, impossible d'affecter à un tableau

Pour quelle raison ?

Merci de votre aide.

Manu


"h2so4" <eric.de.schrevel@gmail.com> a écrit dans le message de news:
24738897.228.1326373408351.JavaMail.geo-discussion-forums@vbhs7...
Le jeudi 12 janvier 2012 13:57:57 UTC+1, h2so4 a écrit :
il manquait un morceau de code

bonjour,

voici une modification du code de MichD, qui devrait permettre de gérer
des utilisateurs différents (jusqu'à 10 dans le cas présent).
non-testé.

Private Sub Workbook_Open()
Dim MotDePasse(10) As String, colcritère(10) As String, critère(10) As
String, x As Variant, i As Integer, utilisateur As Integer
Static Compteur As Integer

Call ThisWorkbook.Enable_Macro
MotDePasse(1) = "MichD": colcritère(1) = "K:K": critère(1) = "107": 'Mot
de passe pour ouvrir le fichier
MotDePasse(2) = "Manu": colcritère(2) = "K:K": critère(2) = "250": '
MotDePasse(3) = "Nico": colcritère(3) = "B:B": critère(3) = "66":

Do
x = ""
x = Application.InputBox(Prompt:="Saisir le mot de passe.", Type:=2)
If TypeName(x) = "Boolean" Then
ThisWorkbook.Close
Else
If Compteur = 3 Then
MsgBox "Le classeur doit fermer.", _
vbCritical + vbokok, "attention"
ThisWorkbook.Close
End If
Compteur = Compteur + 1
End If
For i = 1 To 10
If x = MotDePasse(i) Then utilisateur = i: x = "trouvé": Exit For
Next i
Loop Until x = "trouvé"

Application.ScreenUpdating = False
On Error Resume Next
With Feuil1 'Modifie le nom de la propriété Name de ladite feuille
.Unprotect "toto"
.EnableSelection = xlUnlockedCells
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
With .Range(colcritère(utilisateur))
.AutoFilter
.AutoFilter field:=1, Criteria1:=critère(utilisateur),
VisibleDropDown:úlse
End With
.Protect "toto"
End With
Application.ScreenUpdating = True
End Sub




Le mercredi 11 janvier 2012 15:56:13 UTC+1, Manu a écrit :

> Bonjour,
>
> Je souahiterais qu'en fonction d'un mot de passe "titi" à l'ouverture du
> fichier test.xlsm de la feuil1 que mon tableau (qui commence en A1) se
> filtre immediatement sur la colonne K avec le critere "107" (en texte)
> et
> qu'une fois filtré, on ne puisse plus defiltrer , copier coller, ni
> taper
> dans aucunes des cellules pleines, mais avec le droit de taper dans des
> cellules vides. Puis quand on quitte qu'il enleve les filtres pour
> remettre
> tout en normal.
> Ca m'à l'air assez compliqué...
>
> Merci de votre aide
>
> Manu

bonsoir,

chez moi cela fonctionne, peut-être as-tu oublié les modifications sur la ligne DIM ?


Private Sub Workbook_Open()
Dim MotDePasse(10) As String, colcritère(10) As String, critère(10) As String, x As Variant, i As Integer, utilisateur As Integer
Static Compteur As Integer

Call ThisWorkbook.Enable_Macro
MotDePasse(1) = "MichD": colcritère(1) = "K:K": critère(1) = "10 7": 'Mot de passe pour ouvrir le fichier
MotDePasse(2) = "Manu": colcritère(2) = "K:K": critère(2) = "250 ": '
MotDePasse(3) = "Nico": colcritère(3) = "B:B": critère(3) = "66" :

Do
x = ""
x = Application.InputBox(Prompt:="Saisir le mot de passe.", Type: =2)
If TypeName(x) = "Boolean" Then
ThisWorkbook.Close
Else
If Compteur = 3 Then
MsgBox "Le classeur doit fermer.", _
vbCritical + vbokok, "attention"
ThisWorkbook.Close
End If
Compteur = Compteur + 1
End If
For i = 1 To 10
If x = MotDePasse(i) Then utilisateur = i: x = "trouvé": Exit For
Next i
Loop Until x = "trouvé"
Application.ScreenUpdating = False
On Error Resume Next
With Feuil1 'Modifie le nom de la propriété Name de ladite feuille
.Unprotect "toto"
.EnableSelection = xlUnlockedCells
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
With .Range(colcritère(utilisateur))
.AutoFilter
.AutoFilter field:=1, Criteria1:=critère(utilisateur), Visibl eDropDown:=False
End With
.Protect "toto"
End With
Application.ScreenUpdating = True
End Sub

Voici la modification au code du ThisWorkbook :

'------------------------------------------
Private Sub Workbook_Open()
Dim X As Variant, Ok As Boolean
Dim Compteur As Integer, Critère As Variant

Call ThisWorkbook.Enable_Macro
Ok = False
Compteur = 1
Do
X = ""
X = Application.InputBox(Prompt:="Saisir le mot de passe.", _
Title:="Tentative : " & Compteur & "/3", Type:=2)
If TypeName(X) = "Boolean" Then
ThisWorkbook.Close
Else
If Compteur = 3 Then
MsgBox "Le classeur doit fermer.", _
vbCritical + vbokok, "attention"
ThisWorkbook.Close False
End If
Select Case X
'si le mot de passe est MichD
'le critère est 107
Case Is = "MichD"
Critère = 107
Ok = True
'si le mot de passe est MichD
'le critère est 250
Case Is = "Manu"
Critère = 250
Ok = True
'Tu peux ajouter autant de case que tu désires
End Select
Compteur = Compteur + 1
End If
Loop Until Ok = True

Application.ScreenUpdating = False
On Error Resume Next

With Feuil1 'Modifie le nom de la propriété Name de ladite feuille
.Unprotect "toto"
.EnableSelection = xlUnlockedCells
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
With .Range("K:K")
.AutoFilter
.AutoFilter field:=1, Criteria1:=Critère, VisibleDropDown:úlse
End With
.Protect "toto"
End With
Application.ScreenUpdating = True
Me.Saved = True
End Sub

'------------------------------------------
Sub Enable_Macro(Optional X As String)

Application.EnableEvents = True
For Each sh In Worksheets
If sh.Name <> Feuil4.Name Then
sh.Visible = True
End If
Next
Feuil4.Visible = xlVeryHidden
ThisWorkbook.Saved = True

End Sub
'------------------------------------------
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Application.DisplayAlerts = False
If ThisWorkbook.Saved = False Then
res = MsgBox("Désirez-vous enregistrer les modifications apportées au classeur " & _
ThisWorkbook.Name & " ?", vbInformation + vbYesNoCancel)
Select Case res
Case vbYes
Workbook_BeforeSave False, False
Case vbNo
ThisWorkbook.Saved = True
Case vbCancel
Cancel = True
End Select
End If

End Sub
'------------------------------------------
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)

Dim A As String, S As String

If SaveAsUI = True Then
Application.EnableEvents = False
Application.Dialogs(xlDialogSaveAs).Show
Application.EnableEvents = True
Cancel = True
Exit Sub
End If

S = Application.EnableCancelKey
Application.EnableCancelKey = xlDisabled

If SaveAsUI = False Then
Application.ScreenUpdating = False
A = ActiveSheet.Name
With Feuil4
.Protect "MichD", True, True, True, True
.Visible = True
.Select
End With

For Each sh In Worksheets
If sh.Name <> Feuil4.Name Then
sh.Visible = xlVeryHidden
End If
Next

Application.EnableEvents = False
Me.Save
Application.EnableEvents = True

For Each sh In Worksheets
If sh.Name <> Feuil4.Name Then
sh.Visible = True
End If
Next
Sheets(A).Select
Feuil4.Visible = xlVeryHidden
Application.EnableCancelKey = S
End If
Cancel = True
End Sub
'------------------------------------------



MichD
------------------------------------------

Bonjour,

Super Génial, C'est Nickel, à vous 2, la macro fonctionne completement

Vraiment un grand Merci, mais je craint tres prochainement redemander votre
aide car il faudra peut etre encore aller un peu plus loin, mais c'est une
autre histoire, je tiendrai au courant le forum

Encore merci, vous êtes géniaux !

Bon WE

Manu

"h2so4" <eric.de.schrevel@gmail.com> a écrit dans le message de news:
10323557.63.1326391519918.JavaMail.geo-discussion-forums@vbtw36...
bonsoir,

chez moi cela fonctionne, peut-être as-tu oublié les modifications sur la
ligne DIM ?


Private Sub Workbook_Open()
Dim MotDePasse(10) As String, colcritère(10) As String, critère(10) As
String, x As Variant, i As Integer, utilisateur As Integer
Static Compteur As Integer

Call ThisWorkbook.Enable_Macro
MotDePasse(1) = "MichD": colcritère(1) = "K:K": critère(1) = "107": 'Mot de
passe pour ouvrir le fichier
MotDePasse(2) = "Manu": colcritère(2) = "K:K": critère(2) = "250": '
MotDePasse(3) = "Nico": colcritère(3) = "B:B": critère(3) = "66":

Do
x = ""
x = Application.InputBox(Prompt:="Saisir le mot de passe.", Type:=2)
If TypeName(x) = "Boolean" Then
ThisWorkbook.Close
Else
If Compteur = 3 Then
MsgBox "Le classeur doit fermer.", _
vbCritical + vbokok, "attention"
ThisWorkbook.Close
End If
Compteur = Compteur + 1
End If
For i = 1 To 10
If x = MotDePasse(i) Then utilisateur = i: x = "trouvé": Exit For
Next i
Loop Until x = "trouvé"
Application.ScreenUpdating = False
On Error Resume Next
With Feuil1 'Modifie le nom de la propriété Name de ladite feuille
.Unprotect "toto"
.EnableSelection = xlUnlockedCells
.Cells.Locked = False
.Cells.SpecialCells(xlCellTypeFormulas).Locked = True
.Cells.SpecialCells(xlCellTypeConstants).Locked = True
With .Range(colcritère(utilisateur))
.AutoFilter
.AutoFilter field:=1, Criteria1:=critère(utilisateur),
VisibleDropDown:úlse
End With
.Protect "toto"
End With
Application.ScreenUpdating = True
End Sub