Menu

Code qui fonctionne en pas a pas. mais pas en automatique [Résolu]

Messages postés
65
Date d'inscription
mardi 12 décembre 2006
Dernière intervention
30 janvier 2019
-
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.
Afficher la suite 

Votre réponse

4 réponses

Meilleure réponse
Messages postés
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638
1
Merci
Bonjour,

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

Dire « Merci » 1

Heureux de vous avoir aidé ! Vous nous appréciez ? Donnez votre avis sur nous ! Evaluez CommentCaMarche

CCM 57029 internautes nous ont dit merci ce mois-ci

guigol
Messages postés
65
Date d'inscription
mardi 12 décembre 2006
Dernière intervention
30 janvier 2019
1 -
Super. merci beaucoup
Commenter la réponse de Patrice33740
Messages postés
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638
0
Merci
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
Dernière intervention
30 janvier 2019
1 -
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
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638 -
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
Dernière intervention
30 janvier 2019
1 -
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
Dernière intervention
30 janvier 2019
1 -
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 ?
Commenter la réponse de Patrice33740
Messages postés
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638
0
Merci
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

Cordialement
Patrice
guigol
Messages postés
65
Date d'inscription
mardi 12 décembre 2006
Dernière intervention
30 janvier 2019
1 -
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
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638 -
Commenter la réponse de Patrice33740
Messages postés
7623
Date d'inscription
dimanche 13 juin 2010
Dernière intervention
20 février 2019
1638
0
Merci
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
Dernière intervention
30 janvier 2019
1 -
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
Commenter la réponse de Patrice33740