lecture seule + feuilles cachées

[yann17]

Bonjour à tous,

je rencontre un petit problème avec mon code. A l'ouverture je vérifie que l'utilisateur (windows) soit présent dans une liste sur la feuille "paramétrage". S'il n'est pas présent dans la liste, le fichier s'ouvre en lecture seule, sinon il s’ouvre normalement. Ensuite je souhaite que seule la feuille "accueil" soit visible. Quand le fichier s'ouvre en écriture, aucun problème cela fonctionne, par contre en lecture seule, toutes les feuilles restent visibles et le formulaire ne se lance pas... et je bloque

Voici mon code :

Private Sub Workbook_Open()
Dim Ws As Worksheet
Dim Utilisateur
Dim usertrouve As Range


Utilisateur = Environ("username")
   Application.DisplayAlerts = False
   
   With Sheets("parametrage").Range("B13:J13")
    Set usertrouve = .Find(Utilisateur, , xlValues, xlWhole)
     
       If usertrouve Is Nothing Then
            Workbooks.Open Filename:= _
            "I:\suivi pmcv\BD.xlsm", _
            ReadOnly:=True
       End If
    End With
    
Application.DisplayAlerts = True

'Masque toutes les feuilles sauf la feuille "Accueil"

For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

'Charge l'Userform en mémoire
Load UserForm3

'Affiche l'Userform
UserForm3.Show

End Sub

Merci d'avance pour un petit coup de pouce

 

[camarchepas]

Re : lecture seule + feuilles cachées

Bonjour ,

La solution est logique et pas technique.

Je suppose que le classeur que tu ouvres avec le :
Workbooks.Open Filename:="I:\suivi pmcv\BD.xlsm", ReadOnly:=True

est celui là même qui contient cette macro,

si c'est cela alors le plus simple est certainement d'ajouter pour être sur de toujours y penser dans le module thisworkbook

l'événementiel workbook_beforesave, et dans cette routine écrire une boucle :

For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

comme cela lors de l'ouverture suivante tu n'as que la page accueil visible

Bien sur dans ton workbook_open , il faudra modifier ta boucle pour qu'elle fasse l'inverse ;

For Each Ws In ThisWorkbook.Worksheets
If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVisible
Next Ws

a oui et pour que lors de la réouverture du programme en lecture seul tu ne refasse pas la procédure d'authentification :

toujours dans le workbook_open

if faudra ajouter un saut si le thisworkbook.readonly = true pour te retrouver directement dans la partie du code qui ouvre ton userform

 

[yann17]

Re : lecture seule + feuilles cachées

Bonjour Camarchepas,

merci de t'arrêter pour me filer un coup de pouce. Peux tu me dire comment ajouter un saut pour aller au userform ?
Je ne comprend pas pourquoi il n'est pas possible d'ouvrir le fichier en lecture seule, puis après de masquer les feuilles voulues...
Merci

 

[job75]

Re : lecture seule + feuilles cachées

Bonjour yann17, camarchepas,

Utiliser Application.OnTime pour lancer une 2ème macro dans ThisWorkbook :

Private Sub Workbook_Open()
Dim Utilisateur As String, usertrouve As Range

Application.OnTime 1, "ThisWorkbook.Ouvre"

Utilisateur = Environ("username")

With Sheets("parametrage").Range("B13:J13")
  Set usertrouve = .Find(Utilisateur, , xlValues, xlWhole)
End With

'le fichier est rouvert en lecture seule
If usertrouve Is Nothing And Not Me.ReadOnly Then Workbooks.Open Me.FullName, ReadOnly:=True

End Sub

Sub Ouvre()
Dim Ws As Worksheet

'Masque toutes les feuilles sauf la feuille "Accueil"
For Each Ws In Me.Worksheets
  If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

'Affiche l'Userform
UserForm3.Show

End Sub

A+

 

[job75]

Re : lecture seule + feuilles cachées

Re,

S'il y a des fonctions volatiles comme AUJOURDHUI() ou MAINTENANT() qui se recalculent à l'ouverture du classeur, il faut utiliser Application.DisplayAlerts :

Private Sub Workbook_Open()
Dim Utilisateur As String, usertrouve As Range

Application.OnTime 1, "ThisWorkbook.Ouvre"

Utilisateur = Environ("username")

With Sheets("parametrage").Range("B13:J13")
  Set usertrouve = .Find(Utilisateur, , xlValues, xlWhole)
End With

'le fichier est rouvert en lecture seule
If usertrouve Is Nothing And Not Me.ReadOnly Then
  Application.DisplayAlerts = False
  Workbooks.Open Me.FullName, ReadOnly:=True
End If

End Sub

Sub Ouvre()
Dim Ws As Worksheet

'Masque toutes les feuilles sauf la feuille "Accueil"
For Each Ws In Me.Worksheets
  If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

'Affiche l'Userform
UserForm3.Show

End Sub

A+

 

[camarchepas]

Re : lecture seule + feuilles cachées

Bonjour Yann , Job

Moi, je voyais juste que si tes macros sont désactivées, et bien des onglets sont visibles.

Encore des efforts qui ne servent à rien, voilà pourquoi , je te proposais de les masquer sur l'enregistrement classeur.

Mais bon c'es toi qui aura le dernier mot de toute façon ....

essayes juste de modifier ta boucle comme ceci :


For Each Ws In ActiveWorkbook.Worksheets
If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

 

[job75]

Re : lecture seule + feuilles cachées

Hello camarchepas,

Il faut comprendre que quand le classeur est rouvert la macro Workbook_Open ne s'exécute pas une 2ème fois.

Donc dans ce cas le code situé après l'instruction Workbooks.Open ne s'exécute pas.

D'où la nécessité de Application.OnTime.

A+

 

[camarchepas]

Re : lecture seule + feuilles cachées

Re ,

Ok autant pour moi , mais je trouve que la conception de base entraine une usine à gaz , enfin.

reste à en voir l'usage, comme cela n'est pas expliqué , peut être qu'en mettant simplement l'identification dans l'évenementiel beforesave du classeur interdisant la sauvegarde si pas connu , cela aurait fait l'affaire , et on gagnait en simplicité et en temps d'accès au fichier.

Mais sinon effectivement s'il veut se tenir à cette version , c'est surement la meilleur solution ....

 

[yann17]

Re : lecture seule + feuilles cachées

Bonjour à tous,

J'ai continué a chercher de mon côté avant de voir vos messages, et j'ai trouvé une solution simple qui semble fonctionner parfaitement :

Private Sub Workbook_Open()

Dim Ws As Worksheet
Dim Utilisateur
Dim usertrouve As Range



'verifie l'utilisateur windows pour lecture seule
Utilisateur = Environ("username")
   
   With Sheets("parametrage").Range("B13:J13")
    Set usertrouve = .Find(Utilisateur, , xlValues, xlWhole)
     
       If usertrouve Is Nothing Then
        ThisWorkbook.ChangeFileAccess Mode:=xlReadOnly  
       End If
   End With
    

'Masque toutes les feuilles sauf la feuille "Accueil"
For Each Ws In ThisWorkbook.Worksheets
    If Ws.Name <> "Accueil" Then Ws.Visible = xlSheetVeryHidden
Next Ws

'Charge l'Userform en mémoire
Load UserForm3

'Affiche l'Userform
UserForm3.Show


End Sub

En revanche, dans ce fichier j'ai en colonne A (a partir de A4) des dates (le tri est fait par ordre croissant). Je souhaiterais faire une recherche de A4 jusqu'à la dernière cellule non vide, pour vérifier s'il manque des dates, et les afficher dans un msgbox.
Mais j'avoue ne même pas avoir un début de piste, je suis dans le flou.
Si qqn a une idée...

En tout cas merci à vous pour votre aide. L'apprentissage et long et périeux

 

[job75]

Re : lecture seule + feuilles cachées

Re,

Pour ce nouveau problème il aurait été mieux d'ouvrir une nouvelle discussion.

Enfin c'est relativement simple, voyez cette macro :

Sub DatesManquantes()
Dim t, d As Object, i As Long, mes As String
With Feuil1 'CodeName de la feuille
  t = .Range("A4", .Range("A" & .Rows.Count).End(xlUp)(5)) '(5) assure au moins 2 éléments
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If IsDate(t(i, 1)) Then d(CLng(t(i, 1))) = ""
Next
If d.Count Then
  For i = Application.Min(d.keys) To Application.Max(d.keys)
    If Not d.exists(i) Then mes = mes & vbLf & CDate(i)
  Next
  mes = Mid(mes, 2)
  MsgBox IIf(mes = "", "Aucune date", mes) & String(15, " "), , "Dates manquantes"
End If
End Sub

A+

 

[job75]

Re : lecture seule + feuilles cachées

Bonjour yann17, camarchepas,

Une MsgBox ne peut pas contenir plus de 1023 caractères.

S'il y en a plus (donc plus de 93 dates) le plus simple est de restituer dans une feuille de calcul :

Sub DatesManquantes()
Dim t, d As Object, i&, mini&, maxi&, n&, a(), b(), mes$
With Feuil1 'CodeName de la feuille
  t = .Range("A4", .Range("A" & .Rows.Count).End(xlUp)(5)) '(5) assure au moins 2 éléments
End With
Set d = CreateObject("Scripting.Dictionary")
For i = 1 To UBound(t)
  If IsDate(t(i, 1)) Then d(CLng(t(i, 1))) = ""
Next
If d.Count Then
  mini = Application.Min(d.keys)
  maxi = Application.Max(d.keys)
  If maxi - mini + 1 - d.Count Then
    ReDim a(1 To maxi - mini + 1 - d.Count)
    ReDim b(1 To maxi - mini + 1 - d.Count, 1 To 1)
    For i = mini To maxi
      If Not d.exists(i) Then
        n = n + 1
        a(n) = CDate(i)
        b(n, 1) = CDate(i)
      End If
    Next
    mes = Join(a, "-")
  End If
End If
If Len(mes) > 1023 Then
  With Workbooks.Add.Sheets(1) 'nouveau document
    .Name = "Dates manquantes"
    .[A1].Font.Bold = True
    .[A1] = .Name
    .[A2].Resize(n) = b
  End With
Else
  If n = 0 Then mes = "Aucune date..."
  If n < 2 Then mes = mes & String(15, " ")
  MsgBox mes, , "Dates manquantes"
End If
End Sub

A+

 

[yann17]

Re : lecture seule + feuilles cachées

Bonjour Job75,

Merci pour le code "relativement simple", je n'y comprends rien, mais ça fonctionne . J'ai un peu honte, mais a tel point je n'y comprends rien, j'essaye de ne pas afficher de msgbox lorsqu'il ne manque pas de date, et je n'y arrive pas (mais je persiste à essayer de comprendre )
Sinon je suis resté sur ton 1er code, car si je me retrouve avec plus de 5 ou 6 dates manquantes c'est qu'il y a un gros problème

 

[job75]

Re : lecture seule + feuilles cachées

Re,

Dans la macro du post #10, pour ne pas afficher la MsgBox s'il n'y a pas de date :

'---------
  If mes <> "" Then MsgBox mes & String(15, " "), , "Dates manquantes"

A+

 

[yann17]

Re : lecture seule + feuilles cachées

Niquel, un grand merci pour votre aide à tous les deux.