Petit coup de pouce

Bonjour,

Voilà je vous explique mon problème, j'ai actuellement un fichier de gestion des stocks. Il y a donc des sorties et des entrées d'articles tout les jours.

J'ai crée un "système" de code secret, qui signe dans une cellule à coté votre nom pour savoir qui a fait la sortie/entrée du stock.

J'ai fais une mise en forme de la colonne "Code" pour que quand on encode des chiffres, en faisant Enter, cela affiche des "*******".

J'aurai voulu savoir si c'était possible de bloquer l’étirement (incrémentation) des cellules de la colonne "Code". Eviter par exemple que Monsieur "B" étire la cellule du dessus avec le code de Monsieur "A" et donc puisse utiliser son code sans même le connaitre :/

J'ai mis en pièce jointe le problème en question, pour ne pas vous envoyez tout le fichier de gestion (confidentialité )

Si quelqu'un aurait une idée pour pouvoir réaliser ce petit truc.

Merci d'avance,

Johnny A.

Bonjour,

Une proposition à étudier.

Une procédure événementielle empêche la sélection des cellules non-vides et des cellules avec formules.

Cdlt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lo As ListObject, lCol As Long
    If Not Target.ListObject Is Nothing Then
        If Target.Count = 1 Then
            Set lo = Target.ListObject
            lCol = Target.Column - lo.HeaderRowRange.Column + 1
            If (lCol = 1 And Not IsEmpty(Target)) Or Target.HasFormula Then
                lo.HeaderRowRange.Cells(1).Select
            End If
        End If
    End If
End Sub

Bonjour,

C'est pas bête comme idée mais au lancement du fichier, j'ai une erreur.

Screen en pièce jointe

Merci d'avance

EDIT: Je viens de voir qu'on pouvait sélectionner 2 cellules et donc ce n'est pas vraiment opérationnel :/

Johnny A.

Re,

J'ai trouvé ce code

Private Sub Workbook_Open()
'Interdit le tirage des formules dans les 4 directions et le glisser déplacer
Application.CellDragAndDrop = False
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
'Interdit le collage
Application.CutCopyMode = False
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Active le tirage des formules dans les 4 directions et
'la technique Glisser-déplacer pour les cellules.
Application.CellDragAndDrop = True

'Active la possibilité de collage
Application.CutCopyMode = True
End Sub

Le code marche niquel mais moi il me le faudrait rien que pour la colonne "Code", j'ai besoin de copier/coller, etc sur d'autres feuilles :/

Si quelqu'un aurait une idée pour adapter le code que j'ai trouvé.

Merci d'avance

Johnny A.

Re,

Une mise à jour.

Cdlt.

Re,

Pour ton code @Jean-Eric, il serait possible de le faire uniquement sur une feuille précise (par ex: Journal des sorties) et uniquement sur la colonne "Code"?

Merci d'avance,

Johnny A.

Re,

Une nouvelle mise à jour.

La procédure est essentiellement dédiée à la feuille "Journal des sorties".

C'est une procédure événementielle liée à la feuille.

ALT F11, voir cette dernière dans Feuil1 (Journal des entrées).

Cdlt.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Dim lo As ListObject, lCol As Long
    If Not Target.ListObject Is Nothing Then
        Set lo = Target.ListObject
        lCol = Target.Column - lo.HeaderRowRange.Column + 1
        If Target.Count = 1 Then
            If lCol = 1 And Not IsEmpty(Target) Then
                lo.HeaderRowRange.Cells(1).Select
            End If
        Else
            If lCol = 1 Then lo.HeaderRowRange.Cells(1).Select
        End If
    End If
End Sub

Bonjour,

Merci tout marche niquel