message sur suppression de ligne

[angoul]

(resolu)message sur suppression de ligne

Bonsoir

j'ai besoin de votre aide sur un petit probleme

j'aimerai quand je supprime une ou des lignes dans la feuille 1 par exemple, qu'il y ai une petite fenetre qui me dit " ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE "

merci de votre aide

 

[skoobi]

Re : message sur suppression de ligne

Bonjour angol,

Voici un code à mettre dans ThisWorkBook.
En choisissant "non" au message d'avertissement, la suppression est annulée.

Dim rCell As Range, Lig As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
test = rCell(1).Row 'permet de vérifier qu'il ne s'agit pas d'une insertion de ligne
If Err.Number = 0 Then
  If Lig > rCell(1).Row Then 'détecte la suppression de ligne
      If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then Application.Undo
  End If
End If
On Error GoTo 0
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Lig = Rows.Count
Set rCell = Cells(Lig, Target.Column)
End Sub

Edit: petite précision: marche pour toutes les feuilles du fichier.
Edit2: code adapté pour fonctionner aussi sur XL 2007 😉

 

[angoul]

Re : message sur suppression de ligne

merci sa marche super
j'ai rajouter une ligne en rouge quelqu'un peut me dire si c'est bon?
Dim rCell As Range
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
test = rCell(1).Row 'permet de vérifier qu'il ne s'agit pas d'une insertion de ligne
If Err.Number = 0 Then
If 65536 > rCell(1).Row Then 'détecte la suppression de ligne
If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then Application.Undo
End If
Sheets("Facture").Select
End If
On Error GoTo 0
Application.EnableEvents = True
End Sub

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Set rCell = Cells(65536, Target.Column)
End Sub

 

[skoobi]

Re : message sur suppression de ligne

Re,

j'ai édité mon message entre temps, tu ne l'as pas vu je pense.
Si tu veux que cela se produise uniquement sur la feuille Facture, écrit ce code dans le code de la feuille facture:

Dim rCell As Range, Lig As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
test = rCell(1).Row 'permet de vérifier qu'il ne s'agit pas d'une insertion de ligne
If Err.Number = 0 Then
  If Lig > rCell(1).Row Then 'détecte la suppression de ligne
      If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then Application.Undo
  End If
End If
On Error GoTo 0
Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lig = Rows.Count
Set rCell = Cells(Lig, Target.Column)

End Sub

Bonne soirée.

 

[angoul]

Re : message sur suppression de ligne

merci de ton aide, si c'est pas trop compliquer
est ce que quand on clique sur "OUI" pour la suppression, apres il m'ouvre m'affiche la feuille 2, sinon si je clique sur "NON" alors il se passe rien comme maintenant
merci

 

[skoobi]

Re : message sur suppression de ligne

Quand tu clique sur non, cela annule la suppression et pas "il ne se passe rien", je voulais préciser cela.
Pour l'activation de la feuille 2, modifie le code ici (en bleu):

  If Lig > rCell(1).Row Then 'détecte la suppression de ligne
      [B][COLOR=Blue]If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then
        Application.Undo
      Else: Sheets(2).Activate
      End If[/COLOR][/B]
  End If

 

[angoul]

Re : message sur suppression de ligne

merci de ton aide, mais helas cela marche pas
Voila ce que j'ai mis je met mon fichier joint pour que quelqu'un y regarde si possible

Dim rCell As Range, Lig As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
test = rCell(1).Row 'permet de vérifier qu'il ne s'agit pas d'une insertion de ligne
If Err.Number = 0 Then
If Lig > rCell(1).Row Then 'détecte la suppression de ligne
If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then
Application.Undo
Else: Sheets(2).Activate
End If
End If
On Error GoTo 0
Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lig = Rows.Count
Set rCell = Cells(Lig, Target.Column)

End Sub

Il me met " erreur de compilation :"
Bloc if sans end if

merci de votre aide

 

[angoul]

Re : message sur suppression de ligne

bonjour
personne ne peut jeter a mon petit probleme???
merci

 

[skoobi]

Re : message sur suppression de ligne

Re bonjour angoul,

arrfff, désolé, il manquait comme le dit le message d'erreur un "End If" supplémentaire:

Dim rCell As Range, Lig As Long
Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
On Error Resume Next
test = rCell(1).Row 'permet de vérifier qu'il ne s'agit pas d'une insertion de ligne
If Err.Number = 0 Then
If Lig > rCell(1).Row Then 'détecte la suppression de ligne
      If MsgBox("ATTENTION VOUS ALLEZ SUPPRIMER UNE LIGNE, merci de confirmer", vbInformation + vbYesNo) = vbNo Then
        Application.Undo
      Else: Sheets(2).Activate
      End If
  End If
[B][COLOR=blue]End If
[/COLOR][/B]On Error GoTo 0
Application.EnableEvents = True
End Sub
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Lig = Rows.Count
Set rCell = Cells(Lig, Target.Column)
End Sub

 

[angoul]

Re : message sur suppression de ligne

merci de ton aide; c'est trop cool