Empecher la suppressions de certaines lignes

Le 05/02/2018 à 13:53

Bonjour à tous

Je me permets de vous solliciter pour empêcher la suppression ET l'insertion de lignes.

Attention, je voudrai que cet "interdit" ne concerne que certaines lignes.

Dans l'exemple joint, je voudrai pourvoir bloquer ces insertions/suppression si la colonne D est égale à 1.

Merci d'avance pour votre aide

j'ai testée qqchose mais sans grand résultat.

Private Sub Worksheet_Change(ByVal Target As Range)

If Cells(Target.Row, 4) = 1 Then

With Application
            .EnableEvents = False
            .Undo
            MsgBox "Vous ne pouvez pas effacer cette ligne!"
            .EnableEvents = True
End With
Else
Exit Sub
End If
End Sub

Isabelle

21test1.xlsm (11.69 Ko)
Le 05/02/2018 à 16:39

Bonjour,

ci-dessous un code qui devrait fonctionner si vous le placez dans "ThisWorkbook" 

Option Explicit

Dim lignes_sel As New Collection, nb_lignes As Integer

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)

    Set lignes_sel = Nothing: nb_lignes = Sh.UsedRange.Rows.Count
    If Target.Address = Target.EntireRow.Address Then lignes_sel.Add Target.Value

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ligne As Variant

    If Not lignes_sel Is Nothing Then
        For Each ligne In lignes_sel
            If ligne(1, 4) = 1 Then
                If Sh.UsedRange.Rows.Count > nb_lignes Then MsgBox "Vous ne pouvez pas insérer à partir de cette ligne!"
                If Sh.UsedRange.Rows.Count < nb_lignes Then MsgBox "Vous ne pouvez pas supprimer une ligne contenant 1 en colonne D!"
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With
                Exit For
            End If
        Next ligne
    End If

End Sub
Le 05/02/2018 à 19:29

Bonsoir thev

Merci beaucoup, c'est top.

C'est exactement ce que je voulais.

Par contre je comprend pas tout et ça a tendance à m'énerver.

A l'occasion et si tu as le temps bien entendu, pourrai-tu m'expliquer brièvement la logique, parce que j'en étais loin

En tout cas un immense merci pour ton aide.

Bisous et bonne soirée

Isabelle

Le 05/02/2018 à 20:22

Bonsoir,

Etape 1

Lors d'une sélection sur la feuille :

1- sauvegarde dans une variable du module (nb_lignes) du nombre de lignes utilisées

2- si la sélection concerne une ou plusieurs lignes, sauvegarde dans une collection (lignes_sel) du module, des valeurs de chaque ligne de Target. Chaque valeur d'une ligne de Target est un tableau à 2 dimensions dont la première est la ligne et la seconde la colonne.

En rédigeant ce commentaire, je m'aperçois d'ailleurs que le code ne correspond pas pour une sélection de lignes multiples. Ci-dessous correction

Option Explicit

Dim lignes_sel As New Collection, nb_lignes As Integer

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ligne As Range

    Set lignes_sel = Nothing: nb_lignes = Sh.UsedRange.Rows.Count
    If Target.Address = Target.EntireRow.Address Then
        For Each ligne In Target.Rows
            lignes_sel.Add ligne.Value
        Next ligne
    End If

End Sub

Etape 2

Lors d'un changement intervenant dans la feuille, si ce changement se rapporte à la sélection d'une ou plusieurs lignes,

1- récupération à partir de la collection (lignes_sel) des valeurs de chaque ligne sélectionnée, soit un tableau à 2 dimensions de la forme (1,j) où j représente l'indice de colonne

2- si en colonne 4 de ce tableau pour une ligne sélectionnée, on trouve 1, alors on annule l'opération.

Au final, peut être une version plus simple et plus facile à comprendre, sans utilisation d'une collection :

Option Explicit

Dim lignes_sel(), nb_lignes As Integer

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
    Dim ligne As Range

    lignes_sel = Array("", ""): nb_lignes = Sh.UsedRange.Rows.Count
    If Target.Address = Target.EntireRow.Address Then lignes_sel = Target.Value

End Sub

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
    Dim i As Integer

    If UBound(lignes_sel) > 0 Then
        For i = 1 To UBound(lignes_sel)
            If lignes_sel(i, 4) = 1 Then
                If Sh.UsedRange.Rows.Count > nb_lignes Then MsgBox "Vous ne pouvez pas insérer à partir de cette ligne!"
                If Sh.UsedRange.Rows.Count < nb_lignes Then MsgBox "Vous ne pouvez pas supprimer une ligne contenant 1 en colonne D!"
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With
                Exit For
            End If
        Next i
    End If

End Sub

Si vous avez besoin d'une explication complémentaire, n'hésitez pas.

Le 05/02/2018 à 21:03

Re,

Merci c'est déjà beaucoup plus clair. Merci d'avoir pris le temps de m'expliquer

La seule interrogation concerne la feuille qui n'est nommée nul part.

Si j'ai une autre feuille avec la valeur 1 en colonne D, je ne pourrai pas la supprimer non plus.

J'ai tenté en vain de l'appliquer uniquement à la feuille concernée.

c'est pas très grave au final, mais c'est pour ça que je voulais placer le code dans la feuille et non dans "Thisworkbook"

Bonne soirée

Isabelle

Le 05/02/2018 à 22:25
Isabelle78 a écrit :

La seule interrogation concerne la feuille qui n'est nommée nul part.

La feuille est référencée par la variable objet "Sh" de la procédure événementielle de ThisWorkbook. "Sh.UsedRange.Rows.Count" donne le nombre de lignes utilisées de la feuille. Par ailleurs, la variable objet Target est une référence complète qui contient la feuille active.

Puisque vous avez choisi la procédure évènementielle au niveau du classeur et non au niveau de la feuille, cette procédure s'appliquera à n'importe quelle feuille du classeur.

Si vous placez la procédure au niveau d'une feuille, il faudra alors remplacer la variable objet "Sh" par la variable objet "Me" soit "Me.UsedRange.Rows.Count" pour le nombre de lignes utilisées.

La variable objet "Me" se rapporte toujours à l'objet dans lequel est placé le code (Workbook ou WorkSheet ou UserForm).

ci-dessous code

Option Explicit

Dim lignes_sel(), nb_lignes As Integer

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    Dim ligne As Range

    lignes_sel = Array("", ""): nb_lignes = Me.UsedRange.Rows.Count
    If Target.Address = Target.EntireRow.Address Then lignes_sel = Target.Value

End Sub

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim i As Integer

    If UBound(lignes_sel) > 0 Then
        For i = 1 To UBound(lignes_sel)
            If lignes_sel(i, 4) = 1 Then
                If Me.UsedRange.Rows.Count > nb_lignes Then MsgBox "Vous ne pouvez pas insérer à partir de cette ligne!"
                If Me.UsedRange.Rows.Count < nb_lignes Then MsgBox "Vous ne pouvez pas supprimer une ligne contenant 1 en colonne D!"
                With Application
                    .EnableEvents = False
                    .Undo
                    .EnableEvents = True
                End With
                Exit For
            End If
        Next i
    End If

End Sub
Rechercher des sujets similaires à "empecher suppressions certaines lignes"