Discussion :

[retraite83]

Bonjour,

J'essaye d'optimiser une macro pour l'utilisateur mais aussi pour ma compréhension personnelle,après des essais en pas en pas, j'ai trouvé la boucle qui prend tout le temps (une minute) d'exécution de la macro, voici le code

Code :

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

1
2
3
4
5
6
7
8
For i = derligPdf To 1 Step -1
If Cells(i, 40).Value = "X" Then
    For Each shap In ActiveSheet.Shapes
    If shap.TopLeftCell.Row = i Then shap.Delete
    Next
Cells(i, 40).EntireRow.Delete
End If
Next i

en fait il n'y a qu'une image maximum (ou pas) par ligne à supprimer et je me demande si ce code n'est pas optimisable en précisant je ne sais quoi dans la position de l'image

j'ai fait pas mal d'essai mais j'ai rien trouvé de mieux que ce code

pour info derligPDF = 1350 et il y a au maximum 80 lignes contenant une seule image

si vous pouvez me conseiller des pistes merci

[mercatog]

Bonsoir

Pas besoin d'une double boucle

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
Sub test()
Dim Shp As Shape
Dim i As Long
 
Application.ScreenUpdating = False
With Worksheets("Feuil1")
    For Each Shp In .Shapes
        i = Shp.TopLeftCell.Row
        If .Range("AN" & i).Value = "X" Then
            Shp.Delete
            .Rows(i).Delete
        End If
    Next Shp
End With
End Sub

[patricktoulon]

re
on peut même se passer de se promener dans le code une la variable ligne

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
Sub test()
    Dim Shp As Shape
    Application.ScreenUpdating = False
    For Each Shp In Worksheets("Feuil1").Shapes
        With Shp.TopLeftCell.EntireRow
            If .Cells(1, "AN").Value = "X" Then
                Shp.Delete
                .Delete
            End If
        Next Shp
    End With
End Sub

la cellule contrôlée c'est la .Cells(1, "AN") de la Shp.TopLeftCell.EntireRow

[eriiic]

Bonjour,

et puis c'est long d'effacer des objets, il lui faut du temps
eric

[retraite83]

Bonjour,

j'ai testé vos 2 suggestions, les lignes ne sont pas supprimées…

Code :

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

1
2
3
4
5
6
7
8
9
With Sheets("Imprimable")
    For Each shap In .Shapes
        i = shap.TopLeftCell.Row
        If .Range("AN" & i).Value = "X" Then
            shap.Delete
            .Rows(i).Delete
        End If
    Next shap
End With

Code :

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

1
2
3
4
5
6
7
8
9
With Sheets("Imprimable")
 For Each shap In Worksheets("Imprimable").Shapes
        With shap.TopLeftCell.EntireRow
            If .Cells(1, "AN").Value = "X" Then
                shap.Delete
                .Delete
            End If
        End With
Next shap

[mercatog]

Bonjour
Il n'y a pas de raison pour que les shapes soient supprimées et non les lignes .

Colorie la ligne contenant la shape et le X en colonne AN et fais un pas à pas .