1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87
| Option Explicit
Dim ongletsupp As String
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'pour définir si la selection est éligible à worksheet_change
ongletsupp = ""
Dim x As Long
x = Intersect(Target.EntireRow, Columns(1)).Cells.Count 'compte les lignes de la sélection, même si sélection multiple
If x = 1 Then 'si sélection porte sur une seule ligne
If Target.Address = Target.EntireRow.Address Then 'et si la selection est une ligne complète
If Target.Columns(7) = "" Then 'et si "" en G
If IsError(Target.Columns(8)) Then 'si erreur car si l'onglet est déjà supprimé, colonne H est #REF et ça bug
ongletsupp = ""
Else
ongletsupp = Target.Columns(8) 'si tout bon !
End If
Else
ongletsupp = "" 'si "option en G
End If
Else
ongletsupp = "" 'si pas une ligne complète
End If
Else 'si selection porte sur plusieurs lignes
ongletsupp = ""
End If
'MsgBox ongletsupp & " " & x
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'si suppression d'une seule ligne, on propose de supprimer l'onglet correspondant
Dim c As String, I As Long
If ongletsupp <> "" Then 'si il y a un code (donc une seule ligne sélectionnée), on propose de supprimer l'onglet correspondant
ongletexiste = False
For Each onglet In Worksheets 'vérifier que l'onglet demandé existe dans l'offre, au cas où il aurait déjà été supprimé
If onglet.Name = ongletsupp Then
ongletexiste = True
End If
Next onglet
If ongletexiste = False Then
ongletsupp = ""
'MsgBox "existe pas"
Exit Sub
Else
'on vérifie l'action faite dans la barre d'outils
With Application.CommandBars("Standard")
On Error Resume Next 'permet de passer outre si l'action n'est pas dans la liste Control, notamment "afficher"
'C sera ="", donc on ne passera pas dans la boucle IF suivante
'recherche de la liste de Undo
I = .FindControl(ID:=128).Index
MsgBox ("I = " & I)
c = .Controls(I).List(1)
'MsgBox ("C " & c)
End With
If c = "Supprimer" Or c = "Effacer" Or c = "Delete" Or c = "Clear" Then 's'il s'agit d'un "Supprimer" ou Effacer (obtenu en faisant Ctrl+X puis Suppr)
Dim A As Boolean
A = False
If Worksheets("Selection").Range("h4").Value = "Français" Then
If MsgBox("Vous avez supprimé la ligne " & ongletsupp & "." & Chr(13) & Chr(10) & "Voulez vous aussi supprimer l'onglet correspondant?", vbYesNo, "Confirmation") = vbYes Then
A = True
End If
Else
If MsgBox("You have delete lign " & ongletsupp & "." & Chr(13) & Chr(10) & "Do you wish also to delete attached sheet?", vbYesNo, "Confirmation") = vbYes Then
A = True
End If
End If
If A = True Then
Application.DisplayAlerts = False
Sheets(ongletsupp).Delete
Application.DisplayAlerts = True
End If
End If
c = "" 'raz pour ne pas garder une valeur en mémoire
I = 0
End If
ongletsupp = "" 'raz pour ne pas garder une valeur en mémoire
End If
End Sub |
Partager