XL 2016 Supprimer une feuille par macro si le texte d'une cellule est modifier

[berru76]

Bonjour
Est il possible de supprimer une feuille par macro si le texte d'une cellule est modifier
Exemple supprimer feuille "inscriptions" si le texte de la cellule C1 de la feuille "Nous" est modifier
Merci pour votre aide

 

[Phil69970]

Bonjour @berru76

Je te propose ce code à mettre dans un module:

Explication:
1) On teste si C1 = nous
2) On teste si la feuille à supprimer existe si oui on supprime la feuille (On ne peux pas supprimer une feuille qui n'existe pas ou plus)

Function Feuille_Existe(Nom As String) As Boolean
    Dim Sh As Object
    For Each Sh In Sheets
        If UCase(Sh.Name) = UCase(Nom) Then
            Feuille_Existe = True
            Exit For
        End If
    Next
End Function
 
Sub Supprimer_Feuille()
    If Sheets("Nous").[C1] = "nous" Then
        Application.DisplayAlerts = False
        If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
        Application.DisplayAlerts = True
    End If
End Sub

Par contre je ne te propose pas de fichier car le code VBA de ton fichier est verrouillé

Je te laisse mettre un bouton pour lancer la macro "Supprimer_Feuille"

*Merci de ton retour

@Phil69970

 

[sylvanu]

Bonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C1]) Is Nothing Then
        On Error Resume Next
        Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
        If Err.Number <> 0 Then Exit Sub    ' Si la feuille Inscriptions n'existe pas on sort
        Application.ScreenUpdating = False
        If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
            Application.DisplayAlerts = False
            Sheets("Inscriptions").Delete
        End If
    End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

A vous d'adapter à votre fichier, la macro se trouve dans la feuille Nous.

 

[berru76]

Bonjour
peut t'on ajouter votre formule dans cette macro cadre 1 existante
j'ai enlever le code vba du fichier joint qui sera plus explicite
Merci a vous

Sub Supprimer_Feuille()
If Sheets("20").[AJ2] = "Nous" Then
Application.DisplayAlerts = False
If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
Application.DisplayAlerts = True
End If
End Sub

dans

Sub Cadre1_Cliquer()

Application.ScreenUpdating = False
Range("C4:C99").Select
Selection.Copy
Dim ws As Worksheet
a = Range("E4")
If IsError(Evaluate("='" & a & "'!A1")) Then
MsgBox "Le nombre d'équipe " & a & " ne correspond pas. Mini 20 / Maxi 96"
Exit Sub
End If
Call MasquerFeuilles
For Each ws In ThisWorkbook.Worksheets
If ws.Name = "Inscriptions" Or ws.Name = "Mode d'emploi" Or ws.Name = "Noms" Or ws.Name = "" & a & "" Then
ws.Visible = xlSheetVisible
End If
Next ws
Sheets("" & a & "").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("F1").Select
Application.ScreenUpdating = True
End Sub

 

[Katido]

C'est un peu sévère de supprimer toute la feuille si une cellule est modifiée...
Pourquoi ne pas protéger la feuille (oui, je sais, on peut toujours craker la protection) ou annuler les modifs avec un Undo ?

 

[berru76]

Je partage les concours avec d'autres clubs
J'ai essayé de ne protéger que la feuille mais cela ne décourage pas certain et après on m'annonce un bug
au moins la je saurais si essai de modif ou pas
merci a vous

 

[berru76]

Bonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :

Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub
    If Not Intersect(Target, [C1]) Is Nothing Then
        On Error Resume Next
        Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
        If Err.Number <> 0 Then Exit Sub    ' Si la feuille Inscriptions n'existe pas on sort
        Application.ScreenUpdating = False
        If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
            Application.DisplayAlerts = False
            Sheets("Inscriptions").Delete
        End If
    End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

A vous d'adapter à votre fichier, la macro se trouve dans la feuille Nous.

Je vais tester et vous tiens au courant
Merci

 

[berru76]

Le souci est que lorsque l'on change le texte de la cellule on nous demande si on veut supprimer la feuille et si l'on dit non le changement se fait
il faudrait que
Sheets("Inscriptions").Delete
se déclenche sans demande de confirmation
Merci

Bonjour @berru76

Je te propose ce code à mettre dans un module:

Explication:
1) On teste si C1 = nous
2) On teste si la feuille à supprimer existe si oui on supprime la feuille (On ne peux pas supprimer une feuille qui n'existe pas ou plus)

Function Feuille_Existe(Nom As String) As Boolean
    Dim Sh As Object
    For Each Sh In Sheets
        If UCase(Sh.Name) = UCase(Nom) Then
            Feuille_Existe = True
            Exit For
        End If
    Next
End Function
 
Sub Supprimer_Feuille()
    If Sheets("Nous").[C1] = "nous" Then
        Application.DisplayAlerts = False
        If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
        Application.DisplayAlerts = True
    End If
End Sub

Par contre je ne te propose pas de fichier car le code VBA de ton fichier est verrouillé
Regarde la pièce jointe 1142422
Je te laisse mettre un bouton pour lancer la macro "Supprimer_Feuille"

*Merci de ton retour

@Phil69970

Un grand Bonjour
toujours aussi réactif
je vais essayer de la mettre dans ma macro Aller a la feuille
Merci a vous

 

[Phil69970]

Bonjour @berru76 , Sylvain

Si tu testes ma macro dans un fichier vierge avec :
1 feuille qui s'appelle Sheets("Nous") avec le mot "nous" en C1
1 feuille qui s'appelle Sheets("Inscriptions")

Tu fais un bouton dans la feuille "Nous" relier à ma macro ==> Supprimer_Feuille

Et tu copies TOUTE ma macro dans un module tu verras que la suppression est sans avertissement

Voir mon fichier exemple

*Si tu veux le faire dans ton fichier tu mets l'instruction suivante dans ta macro à l'endroit et au mement que tu veux que la suppression se déclenche

Supprimer_Feuille

Et bien sur après avoir copier la totalité de ma macro dans un module !!!

@Phil69970

 

[berru76]

Bonsoir
excusez moi aujourd'hui concours vétérans
et je me suis mal expliqué
après x essais sur la formule De sylvanu je pense que je cherchais des complications inutiles pour éviter le changement du nom de club affecté a l'origine si on passais la sécurité de la feuille
J'ai un peu bidouiller (certainement pas dans la norme si vous voyez des chose inutiles corrigé moi) comme j'ai pu la formule de sylvanu car je ne voulais pas de L'alerte et cela fonctionne je l'ai mise directement dans la feuille inscriptions

Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub
If Not Intersect(Target, [H3]) Is Nothing Then
On Error Resume Next
Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
If Err.Number <> 0 Then Exit Sub
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Sheets("Inscriptions").Delete
End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Merci a Sylvain mais dans la macro Sub Cadre1_Cliquer() (Aller a la feuille) je n'arrive pas a l'insérer et la faire fonctionner je suis pas doué pourtant L'idée me semblait très bien aussi


Merci vous

 

[Phil69970]

@berru76

As tu vu mon post #9 et l'as tu essayer ?
Alors tu as des messages d'alertes ?

Dans ton fichier du post #4
' ==> Sheets("20").[AI2].Value est vide donc la suppression ne se fera pas voir JAMAIS !!!!
' ==> Donc à quoi cela sert !!!!!

J'ai commenté TON code dans la "Sub Cadre1_Cliquer"

Sub Cadre1_Cliquer()

Application.ScreenUpdating = False

'*******
'La procedure de suppression de la feuille se lance ici
'elle va tester si les conditions sont ok donc If Sheets("20").[AI2] = "nous"
'Comme Sheets("20").[AI2] est vide la suppression ne se fera jamais !!!
'et supprimer la feuille si besoin
Supprimer_Feuille

'*******

Range("C4:C99").Select
Selection.Copy
Dim ws As Worksheet
a = Range("E4")
If IsError(Evaluate("='" & a & "'!A1")) Then
    MsgBox "Le nombre d'équipe " & a & " ne correspond pas. Mini 20 / Maxi 96"
    Exit Sub
End If

'Ici tu masques toutes les feuilles MAIS n'oublies pas qu'excel veut avoir au moins 1 feuille non masquée que tu le veuilles ou non
Call MasquerFeuilles

'Et ici tu les demasques toutes  !!! MDR
For Each ws In ThisWorkbook.Worksheets
    If ws.Name = "Inscriptions" Or ws.Name = "Mode d'emploi" Or ws.Name = "Noms" Or ws.Name = "" & a & "" Then
        ws.Visible = xlSheetVisible
    End If
Next ws

Sheets("" & a & "").Activate
Range("C4").Select
Selection.PasteSpecial Paste:=xlPasteValues , Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Range("F1").Select

End Sub

Tu pourrais remplacer tout ça par :

Sub Cadre1_Cliquer()
Dim ws As Worksheet, Derlig&

Supprimer_Feuille ' <== A voir si cela sert à quelque chose !!!

a = Range("E4")
If IsError(Evaluate("='" & a & "'!A1")) Then
    MsgBox "Le nombre d'équipe " & a & " ne correspond pas. Mini 20 / Maxi 96"
    Exit Sub
End If
Derlig = [E4]

Sheets("" & a & "").Range("C4:C" & Derlig + 3) = Sheets("Inscriptions").Range("C4:C" & Derlig + 3).Value

End Sub

Voir les commentaires dans le fichier

*J'ai l'impression que tu essayes de monter une belle usine à gaz !!!!

*Merci de ton retour

@Phil69970

 

[sylvanu]

Bonjour tout le monde,
Juste pour répondre à Berru sur ce point :

Merci a Sylvain mais dans la macro Sub Cadre1_Cliquer() (Aller a la feuille) je n'arrive pas a l'insérer et la faire fonctionner je suis pas doué pourtant L'idée me semblait très bien aussi

Vous ne pouvez pas intégrer in extenso une macro Worksheet_Change dans une macro classique.
Worksheet_Change est une macro événementielle et est automatiquement éxécutée lorsqu'on change une valeur dans une cellule.
En effet la valeur de Target est obtenue quand on change la valeur de C1. Dans une macro "normale' cette variable n'est pas initialisée.
Pour l'adapter il faut supprimer la condition faite sur C1, comme par exemple :

'-------------------------------------------------
        On Error Resume Next
        Sheets("Inscriptions").Name = Sheets("Inscriptions").Name
        If Err.Number <> 0 Then Exit Sub    ' Si la feuille Inscriptions n'existe pas on sort
        Application.ScreenUpdating = False
        If MsgBox("Etes vous bien sur de vouloir supprimer la feuille Inscriptions ?", vbYesNo, "Titre ") = vbYes Then
            Application.DisplayAlerts = False
            Sheets("Inscriptions").Delete
        End If
Fin:
Application.ScreenUpdating = True
Application.DisplayAlerts = True
End Sub

Mais cela suppose que cette partie soit activée au bon moment, en fonction de conditions liées à votre contexte.

 

[soan]

Bonjour berru76, le fil,

Je partage les concours avec d'autres clubs
J'ai essayé de ne protéger que la feuille mais cela ne décourage pas certain et après on m'annonce un bug
au moins la je saurais si essai de modif ou pas

à tout hasard :

si les clubs à qui tu envoies ce que tu as fait ne doivent que lire le fichier sans rien modifier, alors je te propose de leur envoyer un fichier PDF ! pour faire cela, sélectionne ta feuille (ou tes feuilles) destinée(s) à être uniquement lues, puis au choix :

* fais Fichier / Imprimer ; pour l'imprimante, choisis : "Microsoft Print to PDF" ; clique au-dessus sur le gros bouton "Imprimer" ; choisis un dossier et un nom de fichier ; clique en bas sur le bouton "Enregistrer" ; c'est ça qui va créer le fichier PDF.

* fais Fichier / Exporter ; côté gauche, "Créer un document PDF / XPS" est déjà sélectionné ➯ c'est inutile de cliquer dessus ; côté droit, clique sur l'unique bouton "Créer PDF / XPS" ; et devine ... oui, c'est ça aussi qui peut créer un fichier PDF.

normalement, les 2 manips créent exactement le même fichier PDF, alors j'suppose que c'est pareil pour Fichier / Imprimer ou Fichier / Exporter.
​

soan

 

[berru76]

Bonjour et merci a tous pour votre aide

pour sylvanu
comme dis plus haut cela fonctionne bien

pour Phil69970
J'ai essayé mais pas réussi a l'intégrer dans dans la formule "aller a la feuille" donc j'abandonne

pour soan
les concours fonctionnent bien (+d'un an d'utilisation)
Si ils ont accès a cette cellule (Nom du club) c'est que le mot de passe de la feuille a été "Forcé"
ensuite si suppression (donc avertissement) / il suffit de ne pas enregistrer les modifications

A+

 

[Phil69970]

@berru76

pour Phil69970
J'ai essayé mais pas réussi a l'intégrer dans dans la formule "aller a la feuille" donc j'abandonne

Tu n'as pas réussi à écrire n'importe ou dans ton code ce mot :

Supprimer_Feuille

Et dans un module copier :

Function Feuille_Existe(Nom As String) As Boolean
    Dim Sh As Object
    For Each Sh In Sheets
        If UCase(Sh.Name) = UCase(Nom) Then
            Feuille_Existe = True
            Exit For
        End If
    Next
End Function
 
Sub Supprimer_Feuille()

' ==> Sheets("20").[AI2].Value est vide donc la suppression ne se fera pas, voir JAMAIS !!!!
' ==> Donc à quoi cela sert !!!!!

    If Sheets("20").[AI2] = "nous" Then
        Application.DisplayAlerts = False
        If Feuille_Existe("Inscriptions") Then Sheets("Inscriptions").Delete
        Application.DisplayAlerts = True
    End If
End Sub

@berru76
As tu ouvert mes fichiers des posts # 9 et 11 ?
Evidement il faut que la condition soit bonne !!!
==> Sheets("20").[AI2] = "nous"

Est ce que cela fonctionne dans les fichiers que j'ai fait ?

Tu voulais une solution sans avertissement et tu as pris une solution avec un message !

@Phil69970