MSG d'alerte pour effacement pour la feuille active.

  • Initiateur de la discussion Initiateur de la discussion piga25
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

piga25

XLDnaute Barbatruc
Bonjour,

J'essai de me lancer dans le VBA, mais là j'avoue mon incompétence (mais je l'aurrai un jour)

Voila, j'ai un fichier de rencontre sportive qui comporte 05 pages contenant chacune le résultat de 05 matchs.
Je souhaite pouvoir effacer les données de ces matchs mais uniquement que sur la page active, ces dernières sont nommées : Journée 1, Journée 2, Journée 3, Journée 4 et Journée 5.

Ce qui fonctionne : J'ai nommé mes cellules de données pour la journée 1 en journée1. (là le script fonctionne).


Ce qui ne fonctionne pas : Comme j'ai 5 fois la même chose, je pense qu'il est possible d'affectuer le script à la page active, puis de selectionner les cellules de données (elles sont toujours au même endroit) puis d'effectuer le script.

Voila le code que j'essai de faire.

VB:
Sub Efface()
'
' Piga25 le 25/10/2012
'
'
    'Application.Goto Reference:="Journée1"
    
    Range("B3:B6").Select 'Organisateur
    Range("B3").Activate
    Range("B9:B12,F9:F12,I9:I12,N9:N12,Q9:Q12").Select  'Visiteur
    Range("Q9").Activate
    Range("C3,G3,K3,O3,R3").Select 'Tirage
    Range("R3").Activate
    Range("D17:D25,G17:H25,K17:K25").Select 'Match 1
    Range("K17").Activate
    Range("D32:D40,G32:H40,K32:H40").Select 'Match 2
    Range("K32").Activate
    Range("D47:D55,G47:H55,K47:K55").Select 'Match 3
    Range("K47").Activate
    Range("D62:D70,G62:H70,K62:K70").Select 'Match 3
    Range("K62").Activate
    Range("D77:D85,G77:H85,K77:K85").Select 'Match 5
    Range("K77").Activate
    Style = vbYesNo + vbDefaultButton1
    Msg = "Effacement des données"
    Title = "Attention suppression de données!"
    Réponse = MsgBox(Msg, Style, Title)
        If Réponse = vbYes Then
            Selection.ClearContents
            Else
            Exit Sub
        End If
    Range("B3").Select
    End Sub

Merci.
 
Re : MSG d'alerte pour effacement pour la feuille active.

Bonjour piga25 🙂

Pour créer les noms Journée1, Journée2..., nomme sur chaque feuille les cellules à effacer en faisant une sélection multiple (touche Ctrl enfoncée).

Pour effacer la plage nommée sur la feuille active :

Code:
Sub Efface()
Dim Style, Msg$, Title$, i As Byte, Plage As Range
Style = vbYesNo + vbDefaultButton1
Msg = "Effacement des données"
Title = "Attention suppression de données!"
For i = 1 To 5
  Set Plage = Evaluate("Journée" & i)
  If Plage.Parent.Name = ActiveSheet.Name Then
    If MsgBox(Msg, Style, Title) = vbYes Then Plage.ClearContents
  End If
Next
End Sub
Edit : on pourrait déclarer Style As Byte, mais ça ne va pas si l'on utilise vbDefaultButton2.

A+
 
Dernière édition:
Re : MSG d'alerte pour effacement pour la feuille active.

Bonjour job75

merci. je regarde cela.
J'avais bien pensé à nommer mes plages pour chaque feuille, mais vu qu'elles sont toujours identiques, j'aurai souhaité pouvoir les selectionner en fonction de la feuille.
C'est à dire si je me trouve sur le feuille journée 1, je lance la macro qui selectionne uniquement les données de la feuille correspondant à la journée 1.
Puis lorsque je suis sur une autre feuille, exemple journée 3, elle exécute le même scripte mais que pour la journée 3 .
Par contre ce que
 
Re : MSG d'alerte pour effacement pour la feuille active.

Re,

Bon, si tu ne veux pas nommer les plages :

Code:
Sub Efface()
Dim Style, Msg$, Title$, i As Byte, Plage As Range
Style = vbYesNo + vbDefaultButton1
Msg = "Effacement des données"
Title = "Attention suppression de données!"
Set Plage = Union([B3:B6,B9:B12,F9:F12,I9:I12,N9:N12,Q9:Q12], _
  [C3,G3,K3,O3,R3,D17:D25,G17:H25,K17:K25], _
  [D32:D40,G32:H40,K32:H40,D47:D55,G47:H55,K47:K55], _
  [D62:D70,G62:H70,K62:K70,D77:D85,G77:H85,K77:K85])
If MsgBox(Msg, Style, Title) = vbYes Then Plage.ClearContents
End Sub
La macro doit toujours être placée dans un Module standard.

A+
 
Re : MSG d'alerte pour effacement pour la feuille active.

Re,

Merci, cela fonctionne comme je le souhaitais.

Je venais juste de trouver un scripte (mais plus long) qui faisait la même chose.
Je le met mais il doit pouvoir être ammélioré, je pense.
Code:
Sub Efface1(Optional ByVal F As Worksheet) 'As Variant()
    If F Is Nothing Then Set F = ActiveSheet ' Assume la feuille active si elle n'est pas précisée.
    Range("B3:B6,B9:B12,F9:F12,I9:I12,N9:N12,Q9:Q12,C3,G3,K3,O3,R3,D17:D25,G17:H25,K17:K25,D32:D40,G32:H40,K32:H40,D47:D55,G47:H55,K47:K55,D62:D70,G62:H70,K62:K70,D77:D85,G77:H85,K77:K85").Select
    Style = vbYesNo + vbDefaultButton1
    Msg = "Effacement des données"
    Title = "Attention suppression de données!"
    Réponse = MsgBox(Msg, Style, Title)
        If Réponse = vbYes Then
            Selection.ClearContents
            Else
            Range("B3").Select
            Exit Sub
        End If
    Range("B3").Select
    End Sub
 
Re : MSG d'alerte pour effacement pour la feuille active.

salut

Si... tu ne veux pas multiplier le nombre de variables, j'avais
Code:
Sub Efface()
  If MsgBox("Effacement des données", vbYesNo, "Attention suppression de données!") = vbYes Then _
  Range("B3:B6,B9:B12,F9:F12,I9:I12,N9:N12,Q9:Q12,C3,G3,K3,O3,R3,D17:D25,G17:H25,K17:K25,D32:D40,G32:H40,K32:H40,D47:D55,G47:H55,K47:K55,D62:D70,G62:H70,K62:K70,D77:D85,G77:H85,K77:K85").ClearContents
  Range("B3").Select
End Sub
 
Re : MSG d'alerte pour effacement pour la feuille active.

Re, salut Si...

Attention quand on écrit Range("aaa,bbb,ccc,...xxx,yyy,zzz") car le nombre de caractères (ou de zones ?) est limité.

C'est pour ça que j'ai utilisé Union.

Par ailleurs Piga il faut se mettre dans la tête qu'en VBA les Select sont généralement inutiles et même nuisibles.

A+
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD
Retour