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

Résolu
guigol Messages postés 66 Statut Membre -  
guigol Messages postés 66 Statut Membre -
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.

4 réponses

  1.
    Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    Bonjour,

    Voici un exemple que fonctionnent avec les 4 fichiers sources envoyés en MP :
    https://mon-partage.fr/f/lSCqj0bu/
    1
    1. guigol Messages postés 66 Statut Membre 1
       
      Super. merci beaucoup
      0
  2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    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


    0
    1. guigol Messages postés 66 Statut Membre 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.
      0
    2. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
       
      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
      0
    3. guigol Messages postés 66 Statut Membre 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,....
      0
    4. guigol Messages postés 66 Statut Membre 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 ?
      0
  3. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    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

    0
    1. guigol Messages postés 66 Statut Membre 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.
      0
  4. Patrice33740 Messages postés 8400 Date d'inscription   Statut Membre Dernière intervention   1 783
     
    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 ?
    0
    1. guigol Messages postés 66 Statut Membre 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
      0

Discussions similaires

Code 45
Utilisateur anonyme -
Utilisateur anonyme -

10 réponses