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
Bonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :
VB:
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...
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)
VB:
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"
Bonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :
VB:
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.
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
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 ?
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
Bonjour Berru, Phil,
Une autre approche en PJ.
La macro se déclenche automatiquement lorsqu'on modifie la valeur de Nous C1, avec :
VB:
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.
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
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)
VB:
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"
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
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
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"
VB:
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 :
VB:
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 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 :
VB:
'-------------------------------------------------
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.
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
si les clubs à qui tu envoies ce que tu as fait ne doivent quelire le fichier sans rienmodifier, 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.
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
Tu n'as pas réussi à écrire n'importe ou dans ton code ce mot :
Supprimer_Feuille
Et dans un module copier :
VB:
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 !