Microsoft 365 Besoin amélioration fichier de suivi

[GeoffreyAbid]

Bonjour j'ai un fichier de suivi de stock et j'aimerais deux petites choses
La première serait d'avoir un bouton(avec mdp) quand je clique dessus toutes les feuilles se déverrouillent et quand je reclique dessus elles se verrouillent
Ensuite la dernière chose je souhaiterais qu'il ne soit pas possible d'avoir de doublon de ref Poste dans tout le classeur
Voila je vous joint mon fichier en espérant que vous pourrez m'aider
Merci d'avance et bonne journée

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @GeoffreyAbid
Pour ta première demande voir la macro du fichier joint
Dans la feuille Accueil un bouton de formulaire nommer "Bt_Protection" lance cette macro :

Sub Bascule_Protection()
    Dim Wsh As Worksheet, WshAct As Worksheet
    Set WshAct = ActiveSheet
    On Error GoTo Fin
    bt = Application.Caller
    If bt <> "Bt_Protection" Then Exit Sub
    
    Action = WshAct.Shapes(bt).DrawingObject.Text
    Rép = InputBox("Mdp ?")
    On Error GoTo ErMdp
    
    If Action = "Protéger" Then
        WshAct.Shapes(bt).DrawingObject.Caption = "Déprotéger"
        For Each Wsh In ThisWorkbook.Worksheets
            With Wsh
                Wsh.Protect Rép
            End With
        Next
    Else
        For Each Wsh In ThisWorkbook.Worksheets
            With Wsh
                Wsh.Unprotect Rép
            End With
        Next
        WshAct.Shapes(bt).DrawingObject.Caption = "Protéger"
    End If
    Exit Sub
    
ErMdp:
MsgBox "Mot de passe incorrect !"
Fin:
On Error GoTo 0
End Sub

Pour la deuxième demande : faut-il tester l'unicité de la référence sur toutes les feuilles y compris l'historique ou l'unicité sur chaque feuille une à une ?
Ou est-ce à tester lors de l'exécution du formulaire Ajout ?

Amicalement
Alain

 

[GeoffreyAbid]

Merci pour votre première réponse @AtTheOne la macro est parfaite
Pour la deuxième question J'aimerais que lorsque quelqu'un souhaite rentrer une machine si la machine existe déjà dans les feuilles Stock Doté Prêté Réservé Restitué Alors il y a un message d'erreur et l'action est donc impossible
Encore merci pour votre aide

 

[ChTi160]

Bonsoir GeoffreyAbib
Bonsoir AtTheOne ,le Forum
@GeoffreyAbib pourquoi ne pas avoir l'ensemble des Statuts sur la même feuille ?
Merci
Bonne fin de Soirée
Jean marie

 

[AtTheOne]

Bonsoir à toutes & à tous, bonsoir @GeoffreyAbid , bonsoir @ChTi160

pourquoi ne pas avoir l'ensemble des Statuts sur la même feuille

Ce serai sans doute plus simple pour les validations de données !

Bon dans la configuration actuelle j'ai nommé les tableaux et j'ai créé 6 noms définis:

Nom	Définition
_RéfDoté	=tb_Doté[Réf Poste]
_RéfPrété	=tb_Prété[Réf Poste]
_RéfRéservé	=tb_Réservé[Réf Poste]
_RéfRestitué	=tb_Restitué[Réf Poste]
_RéfStock	=tb_Stock[Réf Poste]
_TestUnicité	=Accueil!$C$6

Dans la cellule Accueil!$C$6 (_TestUnicité) j'ai écris la formule suivante :

=(SOMMEPROD(--(_RéfStock=CELLULE("contenu")))
+SOMMEPROD(--(_RéfDoté=CELLULE("contenu")))
+SOMMEPROD(--(_RéfPrété=CELLULE("contenu")))
+SOMMEPROD(--(_RéfRéservé=CELLULE("contenu")))
+SOMMEPROD(--(_RéfRestitué=CELLULE("contenu"))))<=1

(Au moment de la saisie de la formule une alerte de référence circulaire peut être affichée liée à la fonction Cellule("contenu") sans référence)

Et j'ai limité la validation des données de la colonne "Réf Poste" des 5 tableaux en autoriser : personnalisé avec la formule =_TestUnicité
A toi de reproduire le principe sur ton fichier.

voir le fichier joint
Amicalement
Alain

 

[GeoffreyAbid]

Bonjour j'ai essayé mais je n'y arrive vraiment pas pouvez vous me donner un code adapter a mon fichier ca serait super vous me sauverais
Merci et bonne journée

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @GeoffreyAbid
Voilà ton fichier avec la validation de données implémentée.
J'ai ajouté une macro pour tester l'unicité des nouvelles référence avec ton Userform :

Function NewRéfUnique(Référence As String)
    Dim Dc As Object
    Set Dc = CreateObject("Scripting.Dictionary")
    Tb = [_RéfStock]: For I = 1 To UBound(Tb): Dc(Tb(I, 1)) = Tb(I, 1): Next
    Tb = [_RéfRéservé]: For I = 1 To UBound(Tb): Dc(Tb(I, 1)) = Tb(I, 1): Next
    Tb = [_RéfPrété]: For I = 1 To UBound(Tb): Dc(Tb(I, 1)) = Tb(I, 1): Next
    Tb = [_RéfDoté]: For I = 1 To UBound(Tb): Dc(Tb(I, 1)) = Tb(I, 1): Next
    Tb = [_RéfRestitué]: For I = 1 To UBound(Tb): Dc(Tb(I, 1)) = Tb(I, 1): Next
    If Dc.exists("") Then Dc.Remove ("")
    NewRéfUnique = Not Dc.exists(Référence)
    Set Dc = Nothing
End Function

Cette fonction est appelée par l'événement Change de la TextBox "Ref_PC" de ton formulaire :

Private Sub Ref_PC_Change()
    If Auto Then Exit Sub
    If Not NewRéfUnique(Me.Ref_PC.Text) Then
        MsgBox "La référence " & Me.Ref_PC.Text & " existe déjà !"
        Auto = True: Me.Ref_PC.Text = "": Auto = False
    End If
End Sub

Auto est une variable booléenne qui permet de s'assurer l'événement n'est pas déclenché lors de l'activation du formulaire (en mode Modif).

Si cela te convient, n'oublie pas de marquer ce post comme étant la solution (et non pas ton post #3)

Amicalement
Alain

 

[GeoffreyAbid]

C'est super merci beaucoup pour tout juste je ne comprend pas le bouton Protéger car il n'y a aucun mdp définit et si j'enlève la condition pour le mdp ca ne fonctionne pas

 

[AtTheOne]

Bonjour à toutes & à tous, bonjour @GeoffreyAbid
Il y avait un petit micmac avec les actions du formulaire "F_Modif1" qui appelle les macros Protection et DéProtection du module "Mdl_Protection" avec comme mot de passe 2047NP (ces macros existaient déjà dans ton projet avec ce mot de passe)
Je les ai un peu modifiées pour faire fonctionner tout cela en harmonie :

Sub Protection()
    Dim I As Byte
    ThisWorkbook.Worksheets("Accueil").Shapes("Bt_Protection").DrawingObject.Caption = "Déprotéger"
    For I = 1 To Worksheets.Count
        Sheets(I).Protect Password:="2047NP"
    Next
End Sub

Sub DéProtection()
    Application.ScreenUpdating = False
    Dim I As Byte
    For I = 1 To Worksheets.Count
        Sheets(I).Unprotect Password:="2047NP"
    Next
    ThisWorkbook.Worksheets("Accueil").Shapes("Bt_Protection").DrawingObject.Caption = "Protéger"
    Application.ScreenUpdating = True
End Sub

Remarque : le mot de passe en dur dans le code, n'est pas vraiment une bonne idée, il faudrait que tu protèges également le projet VBA.

N'oublie pas de marquer ce post comme étant la solution si c'est bien le cas

Voir le fichier joint
Amicalement
Alain