Discussion :

[pasterlouis]

Bonjour,
je sollicite votre aide svp: en fait j'essaye de faire une macro qui permet d'EFFACER TOUT CE QUI EST HORS ZONE D'IMPRESSION pour toutes les feuilles de mon classeur(sauf les feuilles qui comportent des graphiques). Mais mon code(voir ci-dessus) marche seulement pour certaines feuilles et pas pour d'autres. il bloque souvent à ce niveau:

Code :

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

Rows("1:" & lignaudessus).Clear

et me dit "Erreur d'Exécution: l'objet Range à échoué!" j'arrive pas à voir c'est quoi le soucis. est ce que vous pouvez m'aider svp
Merci d'avance!

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
48
49
50
51
52
53
54
55
56
57
58
59
60
Private Sub EffacerHorsZoneImpression()
Dim cel, celu, i, coladroite, lignendessous, premcelzi, lignaudessus, colagauche, zi
Dim col, prem, colg
Dim nbCelu As Long
Dim nbgraphs As Integer
Dim f As Integer
 
 
For f = 1 To ActiveWorkbook.Sheets.Count
 Sheets(f).Activate
 nbCelu = 0
 zi = ActiveSheet.PageSetup.PrintArea 'zi=zone d'impression
If zone = "" Then GoTo suivant
For Each cel In Range(zi)
    i = cel.Address
    nbCelu = nbCelu + 1
Next cel
 nbgraphs = ActiveSheet.ChartObjects.Count
If nbgraphs = 0 Then
    'Efface les colonnes à droite de la zone d'impression
    coladroite = Range(i).Offset(0, 1).Columns.Address(ColumnAbsolute:=False)
    col = InStr(coladroite, "$")
    coladroite = Left(coladroite, col - 1)
    Columns(coladroite & ":iv").Clear
 
    'Efface les lignes en dessous
    lignendessous = Range(i).Offset(1, 0).Row
    Rows(lignendessous & ":65536").Clear
 
    'recherche de la première cellule de la zone d'impression
    If nbCelu > 1 Then
        prem = InStr(zi, ":")
        premcelzone = Left(zi, prem - 1)
        Else
        premcelzi = zi
    End If
 
    If premcelzone <> "$A$1" Then
 
    'Efface les lignes au dessus de la zone d'impression
    On Error GoTo line1
    lignaudessus = Range(premcelzi).Offset(-1, 0).Row
    Rows("1:" & lignaudessus).Clear
 
    'Efface les colonnes à gauche de la zone d'impression
line1:
    On Error GoTo suivant
    colagauche = Range(premcelzi).Offset(0, -1).Columns.Address(ColumnAbsolute:=False)
    colg = InStr(colagauche, "$")
    colagauche = Left(colagauche, colg - 1)
    Columns("a:" & colagauche).Clear
 
    End If
End If
 
suivant:
 Application.DisplayAlerts = False
Next f
 Application.DisplayAlerts = True
End Sub

En plus ce code est trop lent. je sais c'est à cause de ceci:

Code :

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

1
2
3
4
For Each cel In Range(zi)
    i = cel.Address
    nbCelu = nbCelu + 1
Next cel

Est ce que vous avez une idée de comment faire pour que ce code ne soit pas si lent?
Merci

[Fvandermeulen]

Salut,

Pour éviter la boucle, tu peux partir de ta zone d'impression en isolant la dernière cellule dans une variable de type Range, du coup tu auras Colonne et Ligne facilement identifiable:

Code :

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

1
2
3
4
5
6
7
8
9
10
11
Dim zi As String
Dim MyCell As Range
Dim LastRow As Long, LastCol As Long
 
zi = ActiveSheet.PageSetup.PrintArea
Set MyCell = ActiveSheet.Range(Replace(Right(zi, Len(zi) - Application.Find(":", zi) - 1), "$", ""))
LastRow = MyCell.Row
LastCol = MyCell.Column
 
Range(Cells(LastRow + 1, LastCol + 1), Cells(LastRow + 1, Columns.Count)).EntireColumn.Clear
Range(Cells(LastRow + 1, LastCol + 1), Cells(Rows.Count, Columns.Count)).EntireRow.Clear

A+

P.S. Il faut repenser tes dimensionnements, ceci n'a aucun intérêt:

Code :

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

Dim col, prem, colg

Sans indiquer le type ta variable sera Variant, donc soit tu te passe de cette ligne soit tu indique pour chaque variable le type souhaité

Code :

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

Dim col as long, prem as long, colg as long

[pasterlouis]

Merci beaucoup pour ta réponse j'ai beaucoup aimé la manière dont tu a évité la boucle. Mais en fait il me met une Erreur d'Execution du genre "Incompatibilité de Type" à ce niveau:

Code :

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

Set MyCell = ActiveSheet.Range(Replace(Right(zi, Len(zi) - Application.Find(":", zi) - 1), "$", ""))

[Fvandermeulen]

Re,

C'est vrai que dans mon exemple je n'ai pas pris en compte deux cas de figure
Pas de zone d'impression => zi vide
Zone d'impression d'une seule cellule => pas de : donc erreur

L'élément commun étant l'impossibilité de trouver le : je propose de tester l'erreur

Code :

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

If Not IsError(Application.Find(":", zi)) Then

Du coup, le code (à toi de voir ce qui se passe en cas de non zi)

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
Dim zi As String
Dim MyCell As Range
Dim LastRow As Long, LastCol As Long
 
zi = ActiveSheet.PageSetup.PrintArea
If Not IsError(Application.Find(":", zi)) Then
    Set MyCell = ActiveSheet.Range(Replace(Right(zi, Len(zi) - Application.Find(":", zi) - 1), "$", ""))
    LastRow = MyCell.Row
    LastCol = MyCell.Column
 
    Range(Cells(LastRow + 1, LastCol + 1), Cells(LastRow + 1, Columns.Count)).EntireColumn.Clear
    Range(Cells(LastRow + 1, LastCol + 1), Cells(Rows.Count, Columns.Count)).EntireRow.Clear
End If

A+

[pasterlouis]

Merci beaucoup cela fonctionne super bien. Merci Fvandermeulen c'est super simpa