Discussion :

[Elodiums]

Boujour,

J'ai fais un fichier qui permet de gérer du REX dans le service où je travaille. J'ai voulu paramétrer un bouton permettant d'enlever du tableau principal de suivi du REX les lignes ayant un statut "REX_Sans suite" et "REX_Traité", à envoyer dans les feuilles d'archives. Le code fonctionnait jusqu'au jour où je me suis rendu compte que si l'on clique sur le bouton pour enlever les données de la feuille principale alors qu'il n'y a aucun "REX_Traité" ou "REX_Sans suite", le programme plante. J'ai pourtant utilisé un If not r is Nothing, qui ne semble pas fonctionner. J'aurai donc besoin de vos lumières sur le code ci-après :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Nettoyer_REX_Sans_suite()
    ' Sauvegarde Auto
    Dim Path As String, valeur As String
    Path = "\\atlas.edf.fr\CO\01bug-dpn\services.004\SME-ES.030\07-Section\15 - REX\00 - Backup_FichierREX\"
    valeur = "FichierREX_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
    ThisWorkbook.SaveAs Path & valeur
    MsgBox ("Sauvegarde réalisée avec succès.")
    ' Fin sauvegarde auto
 
    ' Enlever les filtres
    Dim Sh As Worksheet
 
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.FilterMode Then 'Si on ne voit pas toutes les données
            Sh.ShowAllData
        End If
    Next
    ' Fin enlever les filtres
 
    Dim r As Range
    Dim derlig As Integer
 
    derlig = Feuil4.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Application.ScreenUpdating = False
    Sheets("Suivi REX Gammes - Constats").Select
    Range("1:1").EntireRow.Hidden = True
    Application.CopyObjectsWithCells = False
 
    With ActiveSheet.ListObjects("TabRex").Range
        .AutoFilter Field:=8, Criteria1:="Sans suite"
        Set r = .SpecialCells(xlCellTypeVisible)
        If Not r Is Nothing Then r.Copy Sheets("Archives_REX Sans suite").Range("A" & derlig)
        r.Delete
        .AutoFilter Field:=8
    End With
 
    Range("1:1").EntireRow.Hidden = False
    Sheets("Archives_REX Sans suite").Select
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
 
End Sub

Le message d'erreur est le suivant : "Pas de cellule correspondante".

Merci par avance.

Cordialement,

[Philippe Tulliez]

Bonjour,
Effectivement la méthode SpecialCells de l'objet Range renvoie une erreur si aucun objet n'est renvoyé.
La seule solution, au niveau de mes connaissances actuelles, est l'interception de l'erreur
Exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub t()
  Dim rng As Range
  Dim rngSp As Range
  Set rng = ActiveSheet.Range("A1:H100")
  On Error Resume Next
  Set rngSp = rng.SpecialCells(xlCellTypeFormulas)
  On Error GoTo 0
  If Not rngSp Is Nothing Then
     MsgBox "On continue"
  End If
  Set rng = Nothing: Set rngSp = Nothing
End Sub

Pour en savoir plus sur l'interception des erreurs en VBA, voir La gestion des erreurs dans Excel

[Elodiums]

Merci pour cette aide. J'ai essayé de l'adapter à mon code et ça semble marcher ! A voir avec les utilisations futures ce que cela donnera.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
Sub Nettoyer_REX_Sans_suite()
    ' Sauvegarde Auto
    Dim Path As String, valeur As String
    Path = "\\atlas.edf.fr\CO\01bug-dpn\services.004\SME-ES.030\07-Section\15 - REX\00 - Backup_FichierREX\"
    valeur = "FichierREX_" & Format(Date, "yyyymmdd") & "_" & Format(Time, "hhmmss") & ".xlsm"
    ThisWorkbook.SaveAs Path & valeur
    MsgBox ("Sauvegarde réalisée avec succès.")
    ' Fin sauvegarde auto
 
    ' Enlever les filtres
    Dim Sh As Worksheet
 
    For Each Sh In ThisWorkbook.Worksheets
        If Sh.FilterMode Then 'Si on ne voit pas toutes les données
            Sh.ShowAllData
        End If
    Next
    ' Fin enlever les filtres
 
    Dim r As Range
    Dim derlig As Integer
 
    derlig = Feuil4.Cells(Rows.Count, 1).End(xlUp).Row + 1
    Application.ScreenUpdating = False
    Sheets("Suivi REX Gammes - Constats").Select
    Range("1:1").EntireRow.Hidden = True
    Application.CopyObjectsWithCells = False
 
    With ActiveSheet.ListObjects("TabRex").Range
        .AutoFilter Field:=8, Criteria1:="Sans suite"
        On Error Resume Next
        Set r = .SpecialCells(xlCellTypeVisible)
        On Error GoTo 0
        If Not r Is Nothing Then
        r.Copy Sheets("Archives_REX Sans suite").Range("A" & derlig)
        r.Delete
        .AutoFilter Field:=8
        End If
    End With
 
    ActiveSheet.ListObjects("TabRex").Range.AutoFilter Field:=8
    Range("1:1").EntireRow.Hidden = False
    Sheets("Archives_REX Sans suite").Select
    Application.CopyObjectsWithCells = True
    Application.ScreenUpdating = True
 
End Sub