Discussion :

[retraite83]

Bonjour,

je prépare une boucle pour copier des photos d'une feuille à une autre en réduisant la taille au passage.
Pour mettre au point, j'ai adapté ce que me donne l'enregistreur de macro et commencé par faire une boucle de 1 (pas de boucle)

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Macro3()
Dim i As Integer
 
For i = 2 To 2
 
Workbooks("ES-Catalogue.xlsm").Activate
Sheets("Param Services").Select
'ActiveSheet.Shapes.Range(Array("Picture 170")).Select  Ce que ne donne l'enregistreur de macro
' remplacer par For Each pour préparer une boucle -> ensuite .Range("D" & i)
    For Each shp In ActiveSheet.Shapes
        If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D2").Top Then
        Selection.Copy
 
' Edition du catalogue actif
        Workbooks("ES-Edition du Catalogue des Services.xlsm").Activate
        Range("B8").Select
        ActiveSheet.Paste
        Selection.ShapeRange.ScaleHeight 0.4693333333, msoFalse, msoScaleFromTopLeft
    End If
    Next
 
Next i
End Sub

Le résultat est bon, l'image est copiée et réduite au bon endroit (B8 de feuille2), le problème est que la photo copiée n'est pas D2 de feuille1 comme je voulais le faire, mais systématiquement la photo sur laquelle pointe le curseur sur Feuille2.
Si je sélectionne D6 de feuile2 avec la souris c'est elle qui sera copiée...

[patricktoulon]

re
ben alors retraité pas reveillé?
c'est normal que ce soit la selectionnée qui est copiée

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each shp In ActiveSheet.Shapes
        If shp.Top = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D2").Top Then
        Selection.Copy'

tu boucle sur les shapes avec "shp" sert toi en !
apres tu teste le top tu a interet a ce que le top soit exact

allez pour etre sur de ton coup

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each shp In ActiveSheet.Shapes
        If shp.topleftcell= Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D2") Then
        shp.Copy'

et si l'image ne commence n'est pas exactementen d2 mais deborde sur c2 par exemple

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
For Each shp In ActiveSheet.Shapes
        If shp.topleftcell.row= Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").rows(2) Then
        shp.Copy'

et bien que l'on pourrait debattre aussi sur le fait que tu boucle sur activesheet et tu teste sur nomclasseur.nomsheet.range ,on va pas le faire, je te le signale c'est tout ,au cas ou la macro travaillerait pendant qu'un autre sheet voir un autre classeur est activé

[retraite83]

Ca ne marche plus du tout, plus de copie..

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
 
Sub Macro3()
Dim i As Integer
 
For i = 2 To 2
 
Workbooks("ES-Catalogue.xlsm").Activate
Sheets("Param Services").Select
'ActiveSheet.Shapes.Range(Array("Picture 170")).Select  Ce qu ne donne l'enregistreur de macro
' remplacer par For Each pour préparer une boucle -> ensuite .Range("D" & i)
    For Each shp In ActiveSheet.Shapes
        If shp.TopLeftCell = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("D2") Then
        shp.Copy
 
' Edition du catalogue actif
        Workbooks("ES-Edition du Catalogue des Services.xlsm").Activate
        Range("B8").Select
        ActiveSheet.Paste
        Selection.ShapeRange.ScaleHeight 0.4693333333, msoFalse, msoScaleFromTopLeft
    End If
    Next
 
Next i
End Sub

[patricktoulon]

est tu sur que les image commence en d2 en terme de position

comme j'ai editer
tu boucle sur activesheet!, est tu sur l'ors de cette boucle que le sheets ayant l'image soit celui qui est activé
perso pluto que de faire sur active sheet j'utiliserait une variable object ayant ciblé le bon sheet au préalable

[retraite83]

Oui mes images sont en D2, D3, D4 et ainsi de suite

je veux les mettre en B8, B13, B18 et ainsi de suite de la seconde feuille par une simple boucle (mise en page pour être imprimer),

Peut être y-a-t-il plus simple

Je mets également du texte en page dans ma futur boucle par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
 
Dim i As Integer
Delta = 6
For i = 2 To 2  ' pas de boucle pour commencer
Range("B" & Delta) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("A" & i).Value
Range("M" & Delta + 1) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("B" & i).Value
Range("Q" & Delta + 2) = Workbooks("ES-Catalogue.xlsm").Sheets("Param Services").Range("E" & i).Value

et c'est là que j'ai une image en ("D" & i) aussi à mettre en page pour chaque boucle en ("B" & Delta + 2) , dans l'esprit ça parait simple...

En fait l'enregistreur de macro me donne :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
 
ActiveSheet.Shapes.Range(Array("Picture 170")).Select

je veux simplement remplacer "Picture170" par ("D" & i) dans ma boucle mais comment ?

[patricktoulon]

j'avoue ne plus te comprendre on part maintenant sur des valeur de cells

bon regarde bien cet exemple
j'ai 2 classeurs ouverts (classeur1/classeur2)
dans le classeur 1 je n'ai pas d'image j'ai juste la macro
dans le classeur2 je n'ai pas de macro mais j'ai une image qui a son angle gauche et haut en D2

regarde bien ce code attentivement

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Sub test()
 
    Set sheetsimage = Workbooks("Classeur2").Sheets(1)    'le classeur2.sheet contenant les images
    ThisWorkbook.Activate 'on revient sur le classeur 1 qui doit recevoir l'image
    'on est donc dans le classeur 1 il n'est pas besoins que le (classeur2.sheet ou il ya les images) soit activé on utilise pas "activesheet"
    With sheetsimage    'with global
        For Each shp In .Shapes
            If shp.TopLeftCell = .Range("D2") Then    'si le coin haut gauche de la shapes est quelque part dans "D2" il sera shoppé!!
                ' Debug.Print shp.Name 'juste pour controler
                shp.Copy    'alors on le copie
                ' Edition du catalogue actif
                With Sheets(1)
                    .Range("B8").Select
                    .Paste
                    Selection.ShapeRange.ScaleHeight 0.4693333333, msoFalse, msoScaleFromTopLeft
                End With
            End If
        Next
    End With
End Sub

fait moi plaisir test avec deux fichiers neufs