Copie Shape sans Select

Bonjour tout le monde. :mrgreen:

je disposais de ce code (généré et retouché légèrement par l'enregistreur de macro :aie:), permetant d'aller dans un onglet, selectionner une shape portant un nom défini dans une variable, la copier, aller dans un second onglet, coller la shape dans une cellule, puis la deplacer et lui appliquer une echelle.

Code:

---

1 2 3 4 5 6 7 8 9 10 11

Sheets(WorksheetConsigne).Select ActiveSheet.Shapes.Range(Array(CelluleConsigne.Value)).Select Selection.Copy Sheets(WorksheetCible).Select CelluleCible.Select ActiveSheet.Paste   Selection.ShapeRange.IncrementLeft 4 Selection.ShapeRange.IncrementTop 4   Selection.ShapeRange.ScaleHeight 0.640625, msoFalse, msoScaleFromTopLeft

---

ce code fonctionnait parfaitement, sauf si je faisait du debug (F8) où, la fenetre VB reprenant le focus, les select (pas bien !!!) perdaient la boule.
ce point, connu, ne posait pas de difficulté, je le contournais quand necessaire.

depuis, j'ai ajouté malheureusement une userform qui interomp le déroulement du programme (bien avant ce bout de code), en necessitant une manipulation utilisateur.
évidement, cet ajout, indispensable, fait perdre, comme VB pour le mode debug, le focus.

j'ai beau essayer de le redonner a grand coup de select, j'ai tout essayé, cela ne marche tout simplement plus.

et de toute facon, travailler avec du select, cay le mal.

sauf que là, ce type de "chose" (copier un shape d'un onglet a l'autre dans une cellule donné, puis la deplacer + echelle) je ne sais pas faire autrement (loose)

je suis donc completement coincé. :calim2:


info sur les variables :
WorksheetConsigne : string contenant le nom de l'onglet ou se trouve le shape d'origine.
CelluleConsigne.Value : une cellule bien particulière, situé sur le meme onglet, donnant le nom du shape, un string, quoi (par exemple : "Picture 7")
WorksheetCible : string contenant le nom de l'onglet où l'on veu coller l'image dupliqué.
CelluleCible : un range contenant l'adresse row,collumns, de la cellule sur l'onglet "cible" où l'on veu coller l'image précisement.



comment remplaceriez vous ligne a ligne cette fonction, avec les varriables listé, pour se passer de select (et re-rendre donc viable cette indispensable fonction de ma macro)



en vous remerciant d'avance. :oops:


cordialement.

Bonjour,

Essayez ces deux codes en adaptant les zones nommées et le nom des onglets :

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14

Sub TestDupliquerShape()   Dim CelluleConsigne As Range Dim CellCible As Range     Set CelluleConsigne = Sheets("Source").Range("NomDeLaForme") Set CellCible = Sheets("Cible").Range("DestinationForme") DupliquerShape Sheets("Source"), Sheets("Cible"), CellCible, CelluleConsigne   Set CellCible = Nothing Set CelluleConsigne = Nothing   End Sub

---

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22

Sub DupliquerShape(ByVal FeuilleSource As Worksheet, ByVal FeuilleCible As Worksheet, ByVal CelluleCible As Range, ByVal NomShapeRecherche As String)   Dim ShapeRecherche As Shape   For Each ShapeRecherche In FeuilleSource.Shapes If ShapeRecherche.Name = NomShapeRecherche Then With FeuilleSource.Shapes(NomShapeRecherche) .Select .Copy FeuilleCible.Paste Destination:=CelluleCible With Selection .ShapeRange.IncrementLeft 4 .ShapeRange.IncrementTop 4 .ShapeRange.ScaleHeight 0.640625, msoFalse, msoScaleFromTopLeft End With End With End If Next ShapeRecherche   End Sub

---

Cordialement.

Bonjour

il y a du mieux : si je lance le code en mode "debug", a grand renfort de F8, tout se passe au poil
mais si je lance au milieux de mon debug un F5 ou que je lance le code directement sans debug, il plante.

Erreur D'execution '1004':
La methode 'paste' de l'objet '_worksheet' a écouché.

la ligne désigné par l'erreur est :
FeuilleCible.Paste Destination:=CelluleCible
mais si je fais du F8 (après l'erreur), en réalité, le code parvient à l'etape suivante, et plante sur :
.ShapeRange.IncrementLeft 4

cette fois ci
Erreur d'execution '438':
Propriété ou méthode non gérée par cet objet

il est tout simplement possible que la génération de l'erreur précédente face perdre de la boule au "With Selection", enfin, c'est ce que je penserais, à première vue.


que faire ?


cordialement.

Bonjour,

Avez-vous la possibilité de mettre un fichier exemple (même partiel) en ligne contenant votre Userform et votre macro en indiquant ce que vous souhaitez faire ?

Si votre fichier est du type xlsm, il vous faudra le ziper pour le mettre en ligne.

Cordialement.

Bonjour, et merci beaucoup de t'inquieter de mon sort :aie:


il s'agit fort heureusement d'un projet pro ... pour la qualité de vie au service :weird:
rien de "top secret" ni meme serieux, bien que de nombreuses section du code (dont celle qui m'importe ici) vont ou sont utilisé dans d'autres macro, plus serieuse.

par contre, comme je pense que la facon de contourner le soucis est centralisé dans le bout de code sus cité, mais que la cause du bug est plus "abstraite", et du a "des échanges" avec l'ensemble du code, je ne vois pas trop comment "simplifier" le code pour le concentrer uniquement autour du bug. si j'en retire trop, il y a des chance qu'il se remette a fonctionner sans raison.
j'en profite aussi pour noter que j'ai tenté un "on error resume next" (que vous retrouverez en commentaire) que je vous conseil de tester, tant les résultat sont ... interressant. le systeme ne bug plus (pas de message d'erreur) mais laaaaag énormement. il marche, mais ne fait pas de mise a l'echelle, puis fini a un moment (variable) par se tromper, selectionne la mauvaise forme, et ne va pas plus loin (toujours sans message d'erreur)



je vous passe donc tout le fichier, directement. les dates et les noms de personne sont bidon, donc le fichier ne contient rien de "critique".
il s'agit d'un planning integralement automatisé.
je vous conseil de le tester dans l'etat (bouton actualiser sur l'onglet "fermeture"), il devrait marcher directement (en tout cas, moi, il tourne au poil).
vous aurez a un moment une message box inutile (qui est faite pour "forcer" un refresh de la fenetre qui apparaitra juste apres. j'aurais pu corriger ce bug de maniere plus elegante, mais j'ai été au plus vite / bourrin la dessus). juste ensuite, vous aurez la liste des personnes, qui donne "l'offset" pour le début du calcul du "croissant" (qui amene le croissant vendredi ?)
c'est ridicule :ptdr:, mais par facilité, c'est sur le "croissant" que je vais vous faire voir le bug, parce qu'il est plus facile d'identifier un point ou mettre un arret debug.
mettez dans cette boite de dialogue une personne au pif, et laissez la macro finir son taf (sans bug)

dans la configuration (qui marche) d'origine, les croissant sont symbolisé par des triangle jaune. tout fonctionne. la partie de la fonction en charge de la création de forme géométrique ne souffre donc d'aucun défaut particulier.


maintenant que vous avez vu une fois la macro tourner, allez dans l'onglet "fermeture", et dans la liste déroulante "Croissant" (L10), changez "triangle" par une ou l'autre des "picture" (a priori, pour rester cohérent : Picture 8)
cela "pilote" normalement la fonction graphique pour lui demander, au lieu de dessiner un triangle, de venir chercher la "picture 8" (logo vienoiserie) dans l'onglet "Fermeture" pour venir le "coller" dans "planning".

relancez la macro, vous devriez cette fois ci avoir un message d'erreur apres un "lag".
voila, vous savez ou est le soucis.

pour les point de stop et les section du programme qui vous importe le plus :
ligne 1479 : chargement des tableau de valeur pour calculer (via une gestion de pile visible dans le module 3) les croissants. a priori, ici, tout fonctionne. je vous deconseil un stop ici, ou vous allez vous payer de sacré boucle de programme !
plus pertinant : 2391
ca stoppera le programme en amon de l'appel de procédure graphique, en utilisant les dits tableau chargé précédement. ca le stoppera surtout JUSTE au PREMIER jour "croissant". vous n'aurez pas a faire du F8 pour laisser tout les calculs précédent (et y'en a !) etre fini !

enfin, la fonction elle meme se situe :
4639.
vous pouvez y mettre un stop pour voir QUE la fonction graphique, mais vous risquez peut etre d'avoir des "stop" avant un appel de copie d'image (des création de forme géométrique, par exemple)
c'est ici que se trouve le "on error resume next" que je vous conseil d'activer, juste pour voir.

donc le plus pertinant est alors de mettre le stop dans la partie dédié au copie d'image :
4654.

votre propre fonction (que j'ai a peine retouché) se trouve en 4884.

un stop sur une des lignes sus cité, suivit d'un appuit continue sur F8 déroule le programme SANS BUG. un F5, ou un lancement classique, sans stop, est sanctionné par une erreure 1004.


voila, je sais plus trop quoi faire, et c'est quand meme dommage que cela ne fonctionne pas.
surtout que j'aimerais utiliser cette fonction dans une macro bien plus grosse / puissante / importante que celle ci, et que si ici ca ne fonctionne pas ... y'a de grande chance que je ne parvienne pas a le faire marcher dans cet autre macro. et la, c'est plus génant.


merci beaucoup en tout cas de t'interresser à mon cas.

si tu as besoin de la moindre info sur le fonctionnement ... pas de soucis, je resterais à l'ecoute. mais je reste persuadé qu'il n'est pas necessaire de "debuggé" la macro dans son ensemble. la solution doit etre "locale".
les select, que tu utilise toi meme toujours (With Selection), semblent etre la clé du problème. en tout cas, c'est sur ce type de ligne que le programme fige, et le fait, quand on fait un "on error resume next", qu'il finisse par selectionner un autre shape, pour le modifier (coef scaleheight) puis n'aille pas plus loin est très parlant :
cela signifie qu'a un moment il perd les pédale, et selectionne non le shape qu'il vient de copier, mais un deja présent, puis il plante.
et c'est un truc avec VBA, un peu comme les range, avec lequel je me fache souvent. je n'arrive pas, avec des "shape", a m'en passer totalement. c'est tout mon problème : meme identifié, je ne sais pas modifier des lignes de codes pour me débarrasser totalement de tout select.



Pièce jointe 142682


cordialement.

désolé, j'ai oublié de supprimer dans les référence les controles suivant, inutile et pouvant causer des bugs sur des PC autre que le miens :

Ref Edit Control
Microsoft Commun dialog control 6.

et SURTOUT

caladapter 1.1 type library.

désolé de ne pas avoir livré directement un fichier "propre" :calim2:

promis, je vais m'auto flageler.

j'ai aussi noté que sur certains PC, tout se passe comme sur le miens avec un "on error resume next" : pas de bug franc, et parfois meme l'opération va jusqu'au bout.
mais l'objet selectionné et modifié par la partie de la macroi en charge du déplacement et de la mise a l'echelle agis sur d'autres shape que celle qui vient juste d'etre collé. donc on a des "croissant" de grande taille, et des cercles ou autre forme completement déformé ailleurs sur le planning.
bref, on sent "bien" le soucis "select".


cordialement.

Re-bonjour,

J'ai modifié votre liste dynamique dans la feuille DATA, Picture 7 et 8 n'apparaissaient pas en raison des cellules non renseignées en A18 et A19. Dans la feuille FERMETURE SITE, j'ai nommé la cellule L10 "FormeCroissant".

J'ai ensuite modifié la macro DupliquerShape, car les déplacements et la mise à l'échelle étaient inopérants.

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16

Sub DupliquerShape(ByVal FeuilleSource As Worksheet, ByVal FeuilleCible As Worksheet, ByVal CelluleCible As Range, ByVal NomShapeRecherche As String)   Dim ShapeRecherche As Shape   For Each ShapeRecherche In FeuilleSource.Shapes If ShapeRecherche.Name = NomShapeRecherche Then With FeuilleSource.Shapes(NomShapeRecherche) .Select .Copy FeuilleCible.Paste Destination:=CelluleCible End With End If Next ShapeRecherche   End Sub

---

J'ai créé une nouvelle macro en fin de la macro Actualiser pour renommer les images afin de pouvoir les déplacer (en X seulement). En ce qui concerne la mise à l'échelle, il vaut mieux ajuster le modèle dans la feuille Fermeture Site

Code:

---

1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23

Sub DeplacerImageCroissants(ByVal FeuilleCible As Worksheet, ByVal NomShapeRecherche As String, ByVal DeplacementX As Integer)   Dim ShapeRecherche As Shape Dim CtrI As Long   FeuilleCible.Activate CtrI = 1 For Each ShapeRecherche In FeuilleCible.Shapes If ShapeRecherche.Name = NomShapeRecherche Then FeuilleCible.Shapes.Range(Array(NomShapeRecherche)).Select Selection.Name = NomShapeRecherche & CtrI CtrI = CtrI + 1 End If Next ShapeRecherche   For Each ShapeRecherche In FeuilleCible.Shapes If Mid(ShapeRecherche.Name, 1, Len(NomShapeRecherche)) = NomShapeRecherche Then ShapeRecherche.IncrementLeft DeplacementX End If Next ShapeRecherche   End Sub

---

Cordialement.

Bonjour
tout d'abord, un immence et sincere : MERCI !

concernant le bug de la liste, je l'avais vu aussi. je n'avais pas prévus ce cas la, j'ai donc tout simplement, de mon coté, modifié la formule de sorte a ce que tout les shape (y compris les commentaires) donc, apparaissent, puis j'ai généré une seconde liste a partir de la premiere en filtrant les noms mais en les ordonant (plus de risque de cellule vide ! et c'est l'essentiel). bref, qu'a coup de formule. ca refonctionne, depuis. la nouvelle version en piece jointe est plus bourrine, car une des formules utilisé de mon coté est une macro "pro" que je ne peu copier. j'ai aussi réglé un petit problème que tu n'aurais pu identifier, mais tu identifiera peut etre la différence, par contre :)

concernant les codes que tu viens de me passer.
j'ai tenté le coup d'implanter dans mon excel les formules tel qu'énoncé, en copiant les modifs depuis ton fichier.
la sanction est pour le moins "curieuse" :
coté collègues, chez certains, ça marche parfaitement.
mais pas pour tous (moi compris)

à présent, j'ai une partie plus ou moins importante qui se calcul, puis un lag, suivit d'une "erreure 400" sans autre explication (pas d'arret dans le code, pas d'indication plus précise)
j'ai essayé de faire des modulo autour de votre code :

en supprimant la recherche et en pointant directement le shape portant le nom, c'est a dire :

Code:

---

1 2 3 4

With FeuilleSource.Shapes(NomShapeRecherche) .Select .Copy FeuilleCible.Paste Destination:=CelluleCible End With

---

le résultat est STRICTEMENT IDENTIQUE.
si je cherche a supprimer tout select (ici c'est simple)
toujours erreure 400 chez certains utilisateur (la proportion de ce qui parvient a etre fait est completement incohérent.
si je réduit plus encore, en faisant un :

Code:

---

1 2	FeuilleSource.Shapes(NomShapeRecherche).copy FeuilleCible.Paste Destination:=CelluleCible

---

je retombe sur une 1024 : la methode "paste" de l'objet "worksheet" a échoué.
effectuer un F5 dès l'apparition de cette erreure affiche pourtant le croissant, puis l'apparition du prochain croissant, ou du suivant, ou disons max du 3eme, reprovoque une 1024, soldé par F5, etc, etc, etc ...

il y a un LOOOONG lag avant le 1024, c'est donc très laborieux.
j'ai donc essayé ce code "simplifié a l'extrème" avec un "on error resume next".
c'est monstrueusement lent. mais ... ca marche.
sauf qu'une icone de croissant sur deux ne s'affiche pas !

bref, au final, tout ces essais n'ont rien donné de concluant, j'ai donc laissé le code dans l'etat ou vous me le proposiez. la recherche doit ralentir, c'est logique, mais d'un autre coté, cela parait logique que ca force a pointer "le bon" shape, en évitant les bugs que je citais avant.
c'est quand meme étonnant d'avoir un résultat aléatoire d'un PC a l'autre.

je précise, d'ailleurs, que c'est plutot les PC les plus récent / puissant qui ont tendence a bugger.
les PC très lent, sur lesquels il n'y a aucun "freeze" d'ecran (et donc on voit l'activité de la macro, et chaque icone / forme géométrique se dessiner) semblent dérouler la procédure complètement sans soucis.
c'est les PC rapide, qui n'affichent pas les étapes "éclaté", mais qui freeze le temps du calcul, qui finissent par passer du "freeze graphique" au plantage (pas de réponse) en bonne et due forme.

peut etre que la solution, bourrine, serait de ralentir les PC rapide en les forcant a afficher chaque étape du process de création graphique ?
je ne sais pas comment faire, mais au vu des essais de ce matin, c'est la solution "logique" à laquelle je pense.
je vous passe la derniere version.
j'ai ajouté la gesion "Y" en plus de X a votre étape de deplacement d'icone, cela marche très bien (sur les PC qui le detecte)
j'ai viré le nomdu range, pour pouvoir en plus gerer les autres icones du tableaux. (la flemme de tous les renommer / je connais par coeur les coordonné de chaque cellule)

je te remercie énormément de consacrer du temps a cette petite macro.
j'avoue que ca commence a me rendre chevre, et que je vois plus par quel bout aborder le problème.
je t'ai mis en copie la nouvelle version du fichier.
elle a été calculé, avec les icones, sur le PC d'un collègue. preuve que sur certains PC, cela fonctionne. je l'ai aussi passé en xlsm, plus léger.

Pièce jointe 142911

cordialement.

Bonjour,

Comment fonctionne le fichier que je vous ai transmis sur les postes posant problème ? Avez-vous essayé ?

Cordialement.

j'ai effectivement oublié de le signaler :

meme sanction, exactement les meme cause et les meme effets.

cordialement.

Bonjour,

Vous devriez regarder les points suivants :

• Vous avez une quantité importante de variables non déclarées.
• Certaines variables sont déclarées avec des Dim en tête des modules de feuille.
• Vos procédures et fonctions sont positionnées dans les modules de feuilles.

Je pense qu'il vous faut d'abord restructurer votre projet pour que les procédures et fonctions soient positionnées dans des modules standards et non pas sur des modules de feuilles. Il vous faut également déclarer toutes vos variables avec le bon niveau pour garantir la portabilité. Conseil : Vous notez Option Explicit en tête de chaque module (feuille, standard, userform...) pour vérifier la portabilité de vos variables :

• Si vos variables sont transverses à plusieurs modules et ou userforms, déclarez vos variables Public.
• Si ces variables sont utilisées seulement à l'intérieur d'un module, déclarez les Private.
• Si vous les déclarez à l'intérieur d'une procédure ou fonction déclarez les avec des Dim.

Par ailleurs, pour des questions d'efficacité de maintenance vous auriez intérêt à éclater vos différentes procédures dans différents modules, vue la quantité importante de lignes de code. Vous auriez sans doute intérêt pour votre procédure principale, à n'avoir qu'un nombre de lignes restreint pour seulement lancer les procédures secondaires. Sur des projets importants, j'organise mes modules dans l'ordre du traitement en les hiérarchisant M00_Menu : module menu, M10_Actualiser, M11_ActualiserTraitement1, M12..., M20_AutreTraitementPrincipal...... Par ailleurs pour retrouver facilement l'emplacement de mes procédures ou fonctions, leur nom commence par le nom du module de stockage exemple M10Actualiser().

Enfin, n'hésitez pas à utiliser des procédures paramétriques pour faciliter la recherche des pannes.

Une fois cela réalisé, je pense que vous devriez détecter le problème.

Bon courage à vous.

Cordialement.