Probleme sur macro d'interdiction de suppresion de ligne ou de colonne

Bonjour,

Je rencontre un souci dont je ne trouve pas l'origine j'ai crée une macro pour interdire la suppression de ligne ou de colonne défini pour chaque feuille

Mais cela fonctionne bien sur la première feuille "BOM"

et ensuite elle bloque sur la 2° feuille "MMS" au Niveau du .UNDO

Je ne vois pas ou est le problème

ci dessous le code que j'ai mis dans this woorkbook

Merci d'avance

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

'Empêche d'effacer les COLONNES aprs BC de l'onglet BOM

If (Sh.Name = "BOM" And Target.Column <= 55) Then

If (Target.Address = Target.EntireColumn.Address) Then

With Application

.EnableEvents = False

.Undo

MsgBox "Vous ne pouvez pas effacer cette colonne!", 16

.EnableEvents = True

End With

Else

Exit Sub

End If

End If

If (Sh.Name = "MMS" And Target.Row <= 6) Then

If (Target.Address = Target.EntireRow.Address) Then

With Application

.EnableEvents = False

.Undo

MsgBox "Vous ne pouvez pas effacer cette ligne!", 16

.EnableEvents = True

End With

Else

Exit Sub

End If

End If

End Sub

Bonjour,

Je ne me penche pas sur votre code mais vous en communique un qui empêche toute suppression/insertion de lignes/colonnes sur n'importe quelle feuille

 Option Explicit

Dim nb_lignes As Integer, nb_colonnes As Integer

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

    nb_lignes = Sh.UsedRange.Rows.Count: nb_colonnes = Sh.UsedRange.Columns.Count

End Sub

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

    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 de ligne"
    If Sh.UsedRange.Rows.Count <> nb_lignes Then
        With Application
            .EnableEvents = False: .Undo: .EnableEvents = True
        End With
    End If

    If Sh.UsedRange.Columns.Count > nb_colonnes Then MsgBox "Vous ne pouvez pas insérer à partir de cette colonne!"
    If Sh.UsedRange.Columns.Count < nb_colonnes Then MsgBox "Vous ne pouvez pas supprimer de colonne!"
    If Sh.UsedRange.Columns.Count <> nb_colonnes Then
        With Application
            .EnableEvents = False: .Undo: .EnableEvents = True
        End With
    End If

End Sub

merci beaucoup je vai essayer cela tout de suite

Cela fonctionne est empeche comme demandé par le code de supprimer toutes les lignes et colonnes de la feuille

mais comment faire pour que je puisse empecher la suppression uniquement sur les colonnes de 0 à 54 et les lignes de 0 à 8

comme ceci

Option Explicit

Dim nb_lignes As Integer, nb_colonnes As Integer, ligne As Integer, colonne As Integer

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

    nb_lignes = Sh.UsedRange.Rows.Count: nb_colonnes = Sh.UsedRange.Columns.Count
    ligne = Target.Row: colonne = Target.Column

End Sub

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

    If ligne <= 8 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 de ligne!"
        If Sh.UsedRange.Rows.Count <> nb_lignes Then
            With Application
                .EnableEvents = False: .Undo: .EnableEvents = True
            End With
        End If
    End If

    If colonne <= 54 Then
        If Sh.UsedRange.Columns.Count > nb_colonnes Then MsgBox "Vous ne pouvez pas insérer à partir de cette colonne!"
        If Sh.UsedRange.Columns.Count < nb_colonnes Then MsgBox "Vous ne pouvez pas supprimer de colonne!"
        If Sh.UsedRange.Columns.Count <> nb_colonnes Then
            With Application
                .EnableEvents = False: .Undo: .EnableEvents = True
            End With
        End If
    End If
End Sub

merci beaucoup cela fonctionne

j'ai parlé trop vite

En faite pour faire simple cela fonctionne sur la feuille 1 mais pas sur les autres feuilles j'ai un message

erreur d'execution "1004"

la méthode "UNDO" de l'objet - Application a échoué

que faire car je ne comprends pas pourquoi cela fonctionne sur 1 feuille et pas sur les autres

Communiquez un extrait non confidentiel de votre fichier pour une des feuilles concernées.

IMPOSSIBLE le fichier fait 2MO meme en supprimant le max de fonction

Alors utilise ce site

https://www.cjoint.com/

https://www.cjoint.com/c/HCojoEZ1G1v

voici le lien désolé de répondre seulement maintenant

et merci pour l'aide

Bonjour,

Votre problème pour les autres feuilles vient du fait que vous videz la pile "Undo" par l'exécution de la macro évènementielle "Private Sub Worksheet_Change(ByVal Target As Excel.Range)"

Solution:

1- rendre publique la procédure évènementielle au niveau du classeur "Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)"

2- appeler cette procédure au début de la procédure évènementielle de chaque feuille.

ci-dessous code à insérer dans "ThisWorkbook"

Option Explicit

Dim nb_lignes As Integer, nb_colonnes As Integer, ligne As Integer, colonne As Integer

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

    nb_lignes = Sh.UsedRange.Rows.Count: nb_colonnes = Sh.UsedRange.Columns.Count
    ligne = Target.Row: colonne = Target.Column

End Sub

Public Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)

    If ligne <= 8 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 de ligne!"
        If Sh.UsedRange.Rows.Count <> nb_lignes Then
            With Application
                .EnableEvents = False: .Undo: .EnableEvents = True
            End With
        End If
    End If

    If colonne <= 54 Then
        If Sh.UsedRange.Columns.Count > nb_colonnes Then MsgBox "Vous ne pouvez pas insérer à partir de cette colonne!"
        If Sh.UsedRange.Columns.Count < nb_colonnes Then MsgBox "Vous ne pouvez pas supprimer de colonne!"
        If Sh.UsedRange.Columns.Count <> nb_colonnes Then
            With Application
                .EnableEvents = False: .Undo: .EnableEvents = True
            End With
        End If
    End If
End Sub

ci-dessous instruction à ajouter au début de chaque procédure évènementielle de feuille

Private Sub Worksheet_Change(ByVal Target As Excel.Range)
    Call ThisWorkbook.Workbook_SheetChange(Me, Target)

merci