Erreur macro sur fonction "If Not Intersect..." [Résolu/Fermé]

Signaler
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
-
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
-
Bonjour à tous,

Je débute en macro, et à force de patience de d'heures de lecture sur les forum adéquats, je parviens petit à petit à faire ce que je veux. Cependant, voila que je me heurte à un problème que je n'arrive pas à résoudre malgré mon acharnement depuis quelques jours.

J'ai une feuille de calcul donc avec un macro qui contient ce code (pour nettoyer une zone de la feuille de toutes les formes qui y sont intégrées). La seconde partie servant à supprimer le contenu de la cellule permettant via une autre macro d'y intégrer ces fameuses formes

Sub Effacer_forme_zone_dessin()
ActiveSheet.Unprotect "moncode"
For Each s In ActiveSheet.Shapes
If Not Intersect(s.TopLeftCell, Range("$B$31:$Z$47")) Is Nothing Then
s.Delete
End If
Next s
ActiveSheet.Protect "moncode"
End Sub


Sub Effacer_code_chassis()
ActiveSheet.Range("Y48").Select
Selection.ClearContents
End Sub


Macro activée par un bouton auquel est appliqué ce code :

Sub Nettoyer_zone_dessin()
Call Effacer_forme_zone_dessin
Call Effacer_code_chassis
End Sub


Le problème est le suivant. Lorsque j'applique cette macro, l'effacement se fait sans soucis. En revanche, si je modifie une zone en particulier dans la feuille (définie plus bas dans ce message), la macro présente une "Erreur d'exécution '1004' ...".

La zone modifiée qui provoque ce blocage de la macro est la suivante... Dans la feuille, ce code qui affiche ou masque des shapes (shapes dans une zone autre que celle qui est nettoyé par la macro qui pose problème définie plus haut) :

Private Sub Worksheet_Change(ByVal Target As Range)

If [H19] = "En tunnel" Then 'Si cellule H19 = "En tunnel"
ActiveSheet.Shapes("Rectangle 1").Visible = True 'Affiche la forme
ActiveSheet.Shapes("Rectangle 2").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 3").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 4").Visible = False 'Masque la forme
ElseIf [H19] = "En applique intérieure" Then
ActiveSheet.Shapes("Rectangle 1").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 2").Visible = True 'Affiche la forme
ActiveSheet.Shapes("Rectangle 3").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 4").Visible = False 'Masque la forme
ElseIf [H19] = "En applique extérieure" Then
ActiveSheet.Shapes("Rectangle 1").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 2").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 3").Visible = True 'Affiche la forme
ActiveSheet.Shapes("Rectangle 4").Visible = False 'Masque la forme
ElseIf [H19] = "Autre" Then
ActiveSheet.Shapes("Rectangle 1").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 2").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 3").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 4").Visible = True 'Affiche la forme
ElseIf [H19] = "" Then
ActiveSheet.Shapes("Rectangle 1").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 2").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 3").Visible = False 'Masque la forme
ActiveSheet.Shapes("Rectangle 4").Visible = True 'Affiche la forme
End If
If Not Application.Intersect(Target, Range("Y48")) Is Nothing Then
Call Inserer_schema1à100_F1
Call Inserer_schema101à200_F1
Call Inserer_schema201à300_F1
End If
End Sub


Si la feuille est ouverte avec la Shapes "Rectangle 1" en "True" et les autres en "False", alors le nettoyage se fera sans soucis, et si je change, message d'erreur. Et si je reviens sur "Rectangle 1", ça ne se remettra pas à marcher pour autant.
Un vrai casse-tête :/

Pas évident de fournir des explications claires sans vous joindre le fichier. Y a-t-il une plateforme sur laquelle je pourrais déposer ce fichier pour que vous y voyiez plus clair, et réussissiez j'espère à m'éclairer sur ce problème

4 réponses

Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
J'ai réussi à résoudre le problème grâce à la suggestion de eriiic vis-à-vis du s.Type.

Code modifié :
Sub Effacer_forme_zone_dessin()
ActiveSheet.Unprotect "moncode"
For Each s In ActiveSheet.Shapes
If s.Type = msoPicture Or s.Type = msoLinkedPicture Then
If Not Intersect(s.TopLeftCell, Range("$B$31:$Z$47")) Is Nothing Then
s.Delete
End If
End If
Next s
ActiveSheet.Protect "moncode"
End Sub


Par contre ça ne m'efface que les image insérées par un "copier une zone de cellule" et "coller en tant qu'image".
Or dans cette zone, j'ai également la possibilité d'insérer des images externe via le code qui suit :

Public Sub insere_image()

Dim ficimg As Variant

ActiveSheet.Unprotect "moncode"

On Error Resume Next
ficimg = Application.GetOpenFilename(".jpg,*.jpg", , "Choisissez l'image")

ActiveSheet.Pictures.Insert(ficimg).Select ' insertion

With Selection
.Locked = False
.PrintObject = True
.Placement = xlMoveAndSize
End With
ActiveSheet.Protect "moncode"

End Sub


Avec la modification du code précédent, les images insérées via le bouton "Public Sub insere_image()" ne se supprimer pas lors du nettoyage.
Je vais continuer à creuser, si d'ici mon prochain post quelqu'un a une suggestion, je suis bien entendu preneur =)
1
Merci

Quelques mots de remerciements seront grandement appréciés. Ajouter un commentaire

CCM 76687 internautes nous ont dit merci ce mois-ci

Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
Bon ça n'a pas mis trop de temps au final, il a simplement suffit que je rajoute :

Or s.Type = 13


(13 car l'objet est une image)

J'en profite pour poser une dernière question sur cette feuille, y a-t-il moyen de faire une actualisation de la visualisation de la feuille une fois le nettoyage fait. En effet les images sont bien supprimées, mais elles apparaissent encore à l'écran (suffit que je fasse défiler la feuille, que je change d'onglet ou que j'insère une nouvelle image pour qu'elle disparaisse).

Une proposition ? =)
Messages postés
9633
Date d'inscription
lundi 18 octobre 2010
Statut
Membre
Dernière intervention
19 novembre 2020
1 975
Bonjour

Déposes ton fichier sur cjoint.com et joins le lien obtenu à ton prochain message

Cdlmnt
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
Le fichier en téléchargement ici : https://www.cjoint.com/c/EFsvrtvBSGu

Merci =)
Messages postés
23673
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 novembre 2020
6 490
Bonjour,

J'ai réussi à le faire planter une seule fois, il ne plante plus bien que je n'ai pas sauvegardé après (?)
J'ai eu le temps de voir que c'était un objet nommé "Drop Down 171" qui l'embêtait.
Peut-être pas de propriété TopLeftCell, ce qui serait étonnant, ou un objet fantôme (re ?) avec un nettoyage incomplet.
Tu pourrais te servir de s.type pour ne traiter que des objet du type attendu dans cette plage (en espérant qu'il soit ailleurs), ou du début de s.name selon ce qui est le plus pratique pour toi.
Ou bien traiter l'erreur puisque bizarrement cet objet a l'air de disparaitre tout seul

Si ça peut t'aider à avancer...

eric

Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
Bonjour,

Chez moi la macro ne plante pas à l'ouverture, c'est dès qu'il y a modification de la cellule H19 qu'ensuite la macro "Nettoyer zone de dessin" ne veut plus fonctionner.
Je ne connais pas la fonction s.type ni s.name, je vais aller chercher un peu sur les forum pour voir ce que je peux y dénicher, je reviens ici ensuite pour dire ce que ça donne.
Si tu as des suggestions plus précises à me donner par rapport au fichier, je suis bien sur preneur.
Messages postés
23673
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 novembre 2020
6 490
Bonjour,

Il n'y a pas vraiment de .Refresh ou .Repaint pour les feuilles, c'est sensé être toujours bon ;-)
Tente avec :
ActiveWindow.SmallScroll Down:=1
ActiveWindow.SmallScroll Down:=-1
ou des trucs comme ça.

Rien à voir mais pour ton Module3 tu peux peut-être remplacer tes 20000 lignes de codes par qq chose comme :
Sub Inserer_schema_F1()
    Dim v As Long, pl As Range, c As Range, lig As Long, fini As Boolean, a
    ' v = CLng([Y48])
    v = 217    ' pour tests
    If v <= Application.Max(Cells) Then
        ActiveSheet.Unprotect "moncode"
        Sheets("Schémas").Activate
        Set pl = Cells.Find(v, LookIn:=xlFormulas, Lookat:=xlWhole)
        Set pl = pl.MergeArea
        Set pl = pl.Offset(1, -1).Resize(, pl.Columns.Count + 2)
        Set c = pl.Range("A1")
        Do
            Set c = c.Offset(1)
            If c.Borders(xlEdgeRight).LineStyle = xlNone Then
                Set pl = pl.Resize(pl.Rows.Count + 1)
                Exit Do
            Else
                Set pl = pl.Resize(pl.Rows.Count + 1)
            End If
        Loop
        pl.Select ' pour tests
        Stop ' pour tests
        pl.Copy
        Sheets("Fiche minute 1").Activate
        Range("B32").Select
        ActiveSheet.Pictures.Paste
        ActiveSheet.Protect "moncode"
    End If
End Sub

Je cherche ton nombre sur la feuille (il faut qu'il soit unique). Comme il est dans une cellule fusionnée (presque) à la bonne largeur j'agrandi la sélection décalée et retaillée d'une ligne tant qu'il y a une bordure à gauche.
Pas tout testé tes 225 schémas bien sûr...
Un problème détecté quand même pour tes fenêtres. Ca passe si tu prolonges le trait à gauche avec des pointillés par exemple jusqu'à la vue de dessus qui doit être sélectionnée avec.

Si tes tests confirment que c'est ok tu pourras ajouter des shémas, les déplacer etc sans retoucher au code.
A voir...

eric
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
Super ton explication, merci beaucoup.
Ca semble marcher du tonnerre (pas encore testé pour tous les schémas mais efficace sur ceux testé, y compris sur ceux où j'ai du rajouter une bordure).

Un petit soucis par contre, lorsque je nettoie ma feuille (avec la fameuse macro sur laquelle portait mon sujet à la base), étant donné que la cellule Y48 se retrouvé vidée, je suis renvoyé automatiquement à la feuille "Schémas" (pareil si je supprime manuellement le contenu de la cellule Y48. Sauf que du coup, ma "Fiche minute 1" s'en retrouve déprotégé. Pas cool cette faille :/

Surement une petite condition à rajouter dans le code que tu m'as proposé, mais je ne sais ni où ni quel code rajouter.

L'idéal serait que lorsque je supprime manuellement le contenu de la cellule Y48, ou bien lorsque celle ci est vidé automatiquement lorsque la macro qui nettoie la zone de dessin est activé, le dessin soit simplement supprimé et que je reste sur la feuille active (Fiche minute 1 donc)...et tout ceci bien sur en laissant la feuille protégé ^^

Comptant une fois de plus sur tes lumières =)
Messages postés
23673
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 novembre 2020
6 490
Mon code n'a rien à voir, ça devait déjà te le faire avant.
Regarde les conditions d'appel après
If Not Application.Intersect(Target, Range("Y48")) Is Nothing Then

Teste Y48 et n'appelle la macro que si Y48 n'est pas vide et contient bien un numérique
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
La seule condition d'appel après ce code est
Call Inserer_schema_F1
:/. Je ne pense donc pas que le problème vienne de là étant donné qu'il renvoi directement à ton code
Messages postés
23673
Date d'inscription
mardi 11 septembre 2007
Statut
Contributeur
Dernière intervention
24 novembre 2020
6 490
Oh, un peu d'attention stp !
Tu appelles systématiquement la macro sans tester Y78 alors que tu ne veux pas la lancer si c'est vide...
Messages postés
28
Date d'inscription
dimanche 21 septembre 2008
Statut
Membre
Dernière intervention
19 juin 2015
2
Ah ouiiiiii.

Erreur de débutant (mais il est vrai que je débute ^^).
Merci pour ta patience et tes bons conseils.

Feuille opérationnelle incessamment sous peu, et le tout sera parfaitement exploitable.
Merci encore

Bon week-end =)