Aide sur macro

tben08

XLDnaute Occasionnel
Bonjour,

ci dessous ma macro qui me permet de supprimer une feuille, des lignes sur d'autres feuilles. La macro fonctionne très bien quand on rentre un nom de salarié. Par contre quand je dis annuler à l'inputbox, là ça pose problème. J'ai essayer d'y incorporer un exit sub mais je n'arrive pas à le placer au bon endroit. Je pense qu'il faut modifier la macro pour pouvoir y rajouter l'exit sub mais là ça dépasse mes compétences.

Merci pour votre aide.

Code:
Sub Supp()
Dim Arret As Boolean
Dim Ws As Worksheet
Dim Pers As String
Dim n As Integer
Dim c As Range
Sheets("parametrage").Select
Pers = InputBox("Personne à supprimer (EN MAJUSCULE)", "SUPPRESSION")

'Si l'utilisateur ne clique pas sur annuler ou n'a pas entré un mot vide
If Pers <> "" Then
    'ici c'est une simple précaution pour avertir l'utilisateur
    If MsgBox("Vous êtes certain de supprimer " & Pers & "?" & vbNewLine & "Action irréversible", vbYesNo + vbDefaultButton2 + vbExclamation) = vbYes Then
        
        'On parcour chaque feuille du classeur
        For Each Ws In ThisWorkbook.Worksheets
            With Ws.UsedRange
                'on fait une boucle de recherche sur la plage utilisée de chaque feuille
                Do
                    'ici on fait la recherche à l'aide de la méthode Find (Voir l'Aide)
                    Set c = .Find(Pers, LookIn:=xlValues, LookAt:=xlWhole)
                    'si on trouve la personne, c est la cellule trouvée avec Find
                    If Not c Is Nothing Then
                        'on supprime toute la ligne
                        
                        c.EntireRow.Delete
                        'on incrémente notre compteur n
                        n = n + 1
                        'si on ne trouve plus de personne sur la feuille Ws, on arrête la recherche sur la feuille Ws, logique non?
                    Else
                        Arret = True
                    End If
                Loop While Not Arret
            End With
 
            Arret = False
            'on passe à la feuille suivante
        Next Ws
    Else
        MsgBox "action annulée"
    End If
Else
    MsgBox "Entrez un nom non vide"
End If

Sheets("JANV").Unprotect ("1207")
Sheets("FEV").Unprotect ("1207")
Sheets("MARS").Unprotect ("1207")
Sheets("AVRIL").Unprotect ("1207")
Sheets("MAI").Unprotect ("1207")
Sheets("JUIN").Unprotect ("1207")
Sheets("JUILLET").Unprotect ("1207")
Sheets("AOUT").Unprotect ("1207")
Sheets("SEPT").Unprotect ("1207")
Sheets("OCT").Unprotect ("1207")
Sheets("NOV").Unprotect ("1207")
Sheets("DEC").Unprotect ("1207")

Sheets("JANV").Activate
Dim derniereLigne As Long
Dim myRange As Range
'feuille de janvier
    
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne1
Dim Ligne2
' il manque de donner des valeurs aux variables
Ligne1 = ActiveCell.Row
Ligne2 = ActiveCell.Row - 4
Rows(Ligne1 - 1 & ":" & Ligne2).Select
    Selection.Delete
'feuille de février
Sheets("FEV").Activate
        
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne3
Dim Ligne4
' il manque de donner des valeurs aux variables
Ligne3 = ActiveCell.Row
Ligne4 = ActiveCell.Row - 4
Rows(Ligne3 - 1 & ":" & Ligne4).Select
    Selection.Delete
'feuille de mars
Sheets("MARS").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne5
Dim Ligne6
' il manque de donner des valeurs aux variables
Ligne5 = ActiveCell.Row
Ligne6 = ActiveCell.Row - 4
Rows(Ligne5 - 1 & ":" & Ligne6).Select
    Selection.Delete

'feuille de Avril
Sheets("AVRIL").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne7
Dim Ligne8
' il manque de donner des valeurs aux variables
Ligne7 = ActiveCell.Row
Ligne8 = ActiveCell.Row - 4
Rows(Ligne7 - 1 & ":" & Ligne8).Select
     Selection.Delete
     
'feuille de Mai
Sheets("MAI").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne9
Dim Ligne10
' il manque de donner des valeurs aux variables
Ligne9 = ActiveCell.Row
Ligne10 = ActiveCell.Row - 4
Rows(Ligne9 - 1 & ":" & Ligne10).Select
Selection.Delete
'feuille de Juin
Sheets("JUIN").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne11
Dim Ligne12
' il manque de donner des valeurs aux variables
Ligne11 = ActiveCell.Row
Ligne12 = ActiveCell.Row - 4
Rows(Ligne11 - 1 & ":" & Ligne12).Select
Selection.Delete
'feuille de JuILLET
Sheets("JUILLET").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne13
Dim Ligne14
' il manque de donner des valeurs aux variables
Ligne13 = ActiveCell.Row
Ligne14 = ActiveCell.Row - 4
Rows(Ligne13 - 1 & ":" & Ligne14).Select
Selection.Delete
'feuille de Aout
Sheets("AOUT").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne15
Dim Ligne16
' il manque de donner des valeurs aux variables
Ligne15 = ActiveCell.Row
Ligne16 = ActiveCell.Row - 4
Rows(Ligne15 - 1 & ":" & Ligne16).Select
Selection.Delete
'feuille de Septembre
Sheets("SEPT").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne17
Dim Ligne18
' il manque de donner des valeurs aux variables
Ligne17 = ActiveCell.Row
Ligne18 = ActiveCell.Row - 4
Rows(Ligne17 - 1 & ":" & Ligne18).Select
Selection.Delete
'feuille de Octobre
Sheets("OCT").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne19
Dim Ligne20
' il manque de donner des valeurs aux variables
Ligne19 = ActiveCell.Row
Ligne20 = ActiveCell.Row - 4
Rows(Ligne19 - 1 & ":" & Ligne20).Select
Selection.Delete
'feuille de Novembre
Sheets("NOV").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne21
Dim Ligne22
' il manque de donner des valeurs aux variables
Ligne21 = ActiveCell.Row
Ligne22 = ActiveCell.Row - 4
Rows(Ligne21 - 1 & ":" & Ligne22).Select
Selection.Delete
'feuille de Décembre
Sheets("DEC").Activate
derniereLigne = Range("A" & Rows.Count).End(xlUp).Row 'n° de la dernière ligne non vide de la colonne A
Range("A" & Rows.Count).End(xlUp).Offset(1).Select 'sélection de la première cellule vide de la colonne A

Dim Ligne23
Dim Ligne24
' il manque de donner des valeurs aux variables
Ligne23 = ActiveCell.Row
Ligne24 = ActiveCell.Row - 4
Rows(Ligne23 - 1 & ":" & Ligne24).Select
Selection.Delete

Sheets("JANV").Protect ("1207")
Sheets("FEV").Protect ("1207")
Sheets("MARS").Protect ("1207")
Sheets("AVRIL").Protect ("1207")
Sheets("MAI").Protect ("1207")
Sheets("JUIN").Protect ("1207")
Sheets("JUILLET").Protect ("1207")
Sheets("AOUT").Protect ("1207")
Sheets("SEPT").Protect ("1207")
Sheets("OCT").Protect ("1207")
Sheets("NOV").Protect ("1207")
Sheets("DEC").Protect ("1207")
Sheets("PARAMETRAGE").Unprotect ("1207")

Sheets(Pers).Select
        Application.DisplayAlerts = False ' permet la validation automatique de la demande
        ActiveSheet.Delete
        Application.DisplayAlerts = True ' permet la validation automatique de la demande
 MsgBox n & " enregistrement de " & Pers & " a été supprimé"


End Sub
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Aide sur macro

Si c'est le inputbox du début tu peux essayer de traiter comme ça :
Code:
Pers = Application.InputBox("Personne à supprimer (EN MAJUSCULE)", "SUPPRESSION")

If Pers <> 0 Then
ton code ........
Else: Exit Sub
End If
j'ai testé ça marche : pas oublier d'ajouter APPLICATION. !!!!
 

camarchepas

XLDnaute Barbatruc
Re : Aide sur macro

Bonjour Hervé, Oly et then

Bon , y'a de l'optimisation à faire dans ce code mais bon , il faut pouvoir maintenir aprés ,

donc dans l'état

effectivement Comme le souligne Oly il faut dans :

Else
MsgBox "action annulée" : Exit sub
End If
Else
MsgBox "Entrez un nom non vide" : Exit sub
End If
 

tben08

XLDnaute Occasionnel
Re : Aide sur macro

Alors vos propostions fonctionnent, le soucis c'est que j'ai ma fenetre qui s'ouvre pour me demander le nom à supprimer, ensuite j'ai une fenetre qui s'ouvre et qui me dit que la suppression sera irréversible et ensuite une fenetre pour me dire que l'action a été annulée.

J'aimerais ne pas avoir cette 2 ème fenêtre.

Hervé62 : si je mets le 0 comme toi ici
Code:
If Pers <> 0 Then
, ma macro plante
 

tben08

XLDnaute Occasionnel
Re : Aide sur macro

Bonjour Hervé, Oly et then

Bon , y'a de l'optimisation à faire dans ce code mais bon , il faut pouvoir maintenir aprés ,

donc dans l'état

effectivement Comme le souligne Oly il faut dans :

Else
MsgBox "action annulée" : Exit sub
End If
Else
MsgBox "Entrez un nom non vide" : Exit sub
End If

si tu veux l'optimiser, ça m'intéresse!! pour le moment je me contente de prendre des bouts de macro donc je me doute que par moment il y a des choses en trop..
 

camarchepas

XLDnaute Barbatruc
Re : Aide sur macro

Bonsoir ,

Ok pour optimiser , mais pas sans le classeur pour pouvoir faire au moins une serie de tests.

@Hervé : le application . inputbox ne change pas le probléme de sortie du traitement , et la logique voudrait que le esle fonctionne correctement .

Mais, le code avec les select et etc , plus les répétitions pouvant être évitées par du paramètrage.

Mais encore une fois , je ne m'engage pas la dedans sans avoir de quoi tester .
 

tben08

XLDnaute Occasionnel
Re : Aide sur macro

J'aimerais vous mettre le fichier mais trop gros et la macro concerne beaucoup trop de fichier pour pouvoir le réduire au minimum.

Mais si des membres ont envie que je leur envoie le fichier il n'y a pas de problème. Je ou les membres posterons leur code simplifié pour que tout le monde puisse en profiter?
 

Staple1600

XLDnaute Barbatruc
Re : Aide sur macro

Bonjour à tous

tben08
Pour ce qui concerne les fichiers exemple, l''habitude veut qu'on :
- ne joigne pas le fichier original mais simplement un fichier exemple allégé qui illustre la question posée.
- qu'on zippe le fichier avant envoi (si besoin)

A mon sens un fichier exemple ne devrait jamais dépasser peu ou prou 300 Ko - (non compressé)

Et dans le pire des cas, il existe des hébergeurs gratuits pour les échanges de gros fichiers, mais je le répète (et cela n'engage que moi) un bon fichier exemple devrait toujours pouvoir être joint dans une discussion directement sur le forum.
Si on ne peut pas le joindre, alors ce n'est pas un fichier exemple ;)
 

herve62

XLDnaute Barbatruc
Supporter XLD
Re : Aide sur macro

Bonjour
Comme j'aime pas donner de mauvaises info , c'est vrai que ça plante car j'ai pris toute la macro
mis dans VBA et testé en faisant du "pas à pas"
Il faut simplement supprimer le DIM Pers as string et là ça MARCHE bien
c'est peut -être un défaut mais les DIM ( déjà en 80 avec le BASIC) ça me faisait un peu peur !!!! c'est trop rigoureux
je les mets quand nécessaire ( fonction)
et pour terminer le exit sub se met là si on veut sortir direct :
Code:
Else
    MsgBox "Entrez un nom non vide"
    Exit Sub
End If
bon ..... le message euh ??

Bon WE à tous
 

Discussions similaires

Statistiques des forums

Discussions
311 711
Messages
2 081 792
Membres
101 817
dernier inscrit
carvajal