Code qui fonctionne en pas a pas. mais pas en automatique

Résolu/Fermé

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 - Modifié le 28 janv. 2019 à 20:49
guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 - 30 janv. 2019 à 18:54

Bonsoir

Ci-dessous, mon code.
Lorsque je le fais tourner en pas à pas (F8), il fonctionne sans problème.
Il sélectionne tous les objets de mon fichiersource et les copie dans le fichier créé au bon emplacement.

Lorsque je le lance avec F5, toutes les opérations semblent fonctionner (ouverture, fichier, créattion fichier, selection des objets) sauf la dernière : la copie des objets dans le nouveau fichier.

une idée?

Par avance, merci

Sub CopieObjets()
            'ouvre le classeur...
            Workbooks.Open ("d:\fichiersource.xlsx")
            Nom_Fichier_Source = ActiveWorkbook.Name
            Workbooks.Add (1)
            Nom_Fichier_Final = ActiveWorkbook.Name
            
            Workbooks(Nom_Fichier_Source).Sheets(1).DrawingObjects.Select
            Selection.Copy
            Workbooks(Nom_Fichier_Final).Activate
            Range("A62").Select
            Workbooks(Nom_Fichier_Final).Sheets(1).Paste

End Sub

EDIT : Ajout des balises de code (la coloration syntaxique).
Explications disponibles ici : ICI

Merci d'y penser dans tes prochains messages.

A voir également:

Code qui fonctionne en pas a pas. mais pas en automatique
Le code ascii en informatique - Guide
Message automatique thunderbird - Guide
Code puk bloqué - Guide
Réponse automatique outlook - Guide
Code telephone oublié - Guide

4 réponses

Réponse 1 / 4

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
30 janv. 2019 à 18:24

Bonjour,

Voici un exemple que fonctionnent avec les 4 fichiers sources envoyés en MP :
https://mon-partage.fr/f/lSCqj0bu/

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
30 janv. 2019 à 18:54

Super. merci beaucoup

Réponse 2 / 4

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
28 janv. 2019 à 22:37

Bonjour,

S'il s'agit de copier toutes les formes et de les coller décalées de 61 lignes vers le bas :

Option Explicit
Sub CopieObjets()
Dim wbS As Workbook, wbF As Workbook
Dim shS As Shape, shF As Shape
Dim dT, dL
  Set wbS = Workbooks.Open("d:\fichiersource.xlsx")
  Set wbF = Workbooks.Add(1)
  dT = wbF.Worksheets(1).Range("A62").Top - wbS.Worksheets(1).Range("A1").Top
  dL = wbF.Worksheets(1).Range("A62").Left - wbS.Worksheets(1).Range("A1").Left
  For Each shS In wbS.Worksheets(1).Shapes
    shS.Copy
    wbF.Worksheets(1).Paste
    Set shF = wbF.Worksheets(1).Shapes(shS.Name)
    shF.Top = shS.Top + dT
    shF.Left = shS.Left + dL
  Next shS
'  wbF.Worksheets(1).Range("A1").Activate
End Sub

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
28 janv. 2019 à 23:25

Merci, mais je ne souhaite pas le décaler de 61 lignes vers le bas.
Juste copier coller l'ensemble et que l'ensemble de mes objets soient collés en A62.

Enfin plutot que le haut gauche du groupe formé par tous mes objets se trouve en A62.

j'essaye de decripter ton code pour le modifier. mais je sèche.

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
Modifié le 28 janv. 2019 à 23:51

Alors peut-être :

Sub CopieObjets()
Dim wbS As Workbook, wbF As Workbook
Dim shS As Shape, shF As Shape
  Set wbS = ThisWorkbook 'Workbooks.Open("d:\fichiersource.xlsx")
  Set wbF = Workbooks.Add(1)
  For Each shS In wbS.Worksheets(1).Shapes
    shS.Copy
    wbF.Worksheets(1).Paste
    Set shF = wbF.Worksheets(1).Shapes(shS.Name)
    shF.Top = wbF.Worksheets(1).Range("A62").Top
    shF.Left = wbF.Worksheets(1).Range("A62").Left
  Next shS
'  wbF.Worksheets(1).Range("A1").Activate
End Sub

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
29 janv. 2019 à 00:55

Je me suis mal exprimé.

Je ne souhaite pas que tous mes objets soient en A62.
mais qu'ils soient toujours placés de la meme facon. mais le coin en haut a gauche soit en A62.

imaginons, 4 photos les unes a coté des autres (de gauche a droite par exemple) dans mon fichier d'origine...

Je souhaite que dans mon fichier cible, elles soient toujours les unes a coté des autres, mais que celle a gauche soit en A62, la deuxième a sa droite,....

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
29 janv. 2019 à 01:21

En attendant ta réponse, j'ai pris ton premier cod pour tester. Malheureusement, sur un cas, parmi un dizaine de fichiers sur mon test, les différents shapes se retrouvent dans la zone de la ligne 62, mais mis n'importe comment.

Ne serait il pas plus pratique d'en faire un groupe avant, puis de copier, coller le groupe en A62 ?

Réponse 3 / 4

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
Modifié le 29 janv. 2019 à 01:33

RE,

Dans ce cas :

Option Explicit
Sub CopieObjets()
Const adr$ = "A62"
Dim wbS As Workbook, wbF As Workbook
Dim shS As Shape, shF As Shape
Dim dT, dL
  Set wbS = Workbooks.Open("d:\fichiersource.xlsx")
  ' Chercher l'emplacement de la première forme
  If wbS.Worksheets(1).Shapes.Count > 0 Then
    dT = wbS.Worksheets(1).Shapes(1).Top
    dL = wbS.Worksheets(1).Shapes(1).Left
  End If
  ' Chercher le coin supérieur gauche de l'ensemble des formes
  For Each shS In wbS.Worksheets(1).Shapes
    If shS.Top < dT Then dT = shS.Top
    If shS.Left < dL Then dL = shS.Left
  Next shS
  Set wbF = Workbooks.Add(1)
  ' Copier les formes
  With wbF.Worksheets(1)
    For Each shS In wbS.Worksheets(1).Shapes
      shS.Copy
      .Paste
      Set shF = .Shapes(shS.Name)
      shF.Top = shS.Top - dT + .Range(adr).Top
      shF.Left = shS.Left - dL + .Range(adr).Left
    Next shS
  End With
  Application.Goto wbF.Worksheets(1).Range(adr)
  ActiveWindow.ScrollColumn = wbF.Worksheets(1).Range(adr).Column
  ActiveWindow.ScrollRow = wbF.Worksheets(1).Range(adr).Row
End Sub

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
29 janv. 2019 à 01:41

En fait cela ne fonctionne pas pour un de mes fichiers en particulier. Mais je ne sais pas expliquer pourquoi.

Comment te l'envoyer?

Je n'ai pas forcement envie de le mettre en visu ici.

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
29 janv. 2019 à 08:59

Envoies le en message privé : https://forums.commentcamarche.net/forum/inbox/new/Patrice33740

Réponse 4 / 4

Patrice33740 Messages postés 8556 Date d'inscription dimanche 13 juin 2010 Statut Membre Dernière intervention 2 mars 2023 1 776
30 janv. 2019 à 11:20

Bonjour,

Au vu des fichiers que tu as transmis en MP, cela n'est pas aussi simple :
1) il y a 6 zones sources différentes et donc 6 zones destinations
2) les zones destinations sont plus petites que les zones sources, faut-il redimensionner les formes ?
3) les fichiers destinations contiennent déjà des formes résiduelles, faut-il les supprimer ?

guigol Messages postés 65 Date d'inscription mardi 12 décembre 2006 Statut Membre Dernière intervention 30 janvier 2019 1
30 janv. 2019 à 15:51

1). C'est pour cela que je voulais en faire un groupe :
Prendre toutes les formes de la feuille d'origine, normalement, elles sont toutes entre les lignes 44 et 63.
En faire un groupe
Le coller en A 62 de la feuille destination.

2) Dans l'ideal, oui.
S'assurer que le groupe collé soit bien entre les lignes 62 et 79 de la feuille destination.

3) Des formes résiduelles?
Normalement, non. puisqu'a l'origine de ma macro, je pars a partir d'un fichier vierge

Discussions similaires

[référencement] Ne pas être référencé

Code de renvoi d'appel : Ooredo, Mobilis...

Acces à snapchat temporairement désactivé

Discussions similaires

Newsletters