Discussion :

[Ghost0000]

Bonjour,

J'aimerai copier des images contenu dans des cellules de la colonne C d'un classeur à un autre, pour cela, j'arrive à le faire, mais...les images se copient d'un classeur à l'autre de manière "sauvage" sans se placer correctement...

Comment faire pour récupérer les informations de positionnement du classeur source et permettre une copie parfaite sur le second classeur ?

PS: j'avais deja ouvert une discussion à ce sujet :

Code :

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

1
2
3
4
5
6
7
8
9
10
                    Dim Nb As String
                    Dim Img As Shape
 
                    With Workbooks(2).Sheets("BDD")
                        Nb = ActiveSheet.Shapes.Count
                            For Each Img In ActiveSheet.Shapes
                            Img.Copy
                            Workbooks(1).Sheets("BDD").Paste
                            Next Img
                    End With

Le souci c'est que cela copie bien les images d'une feuille à l'autre, mais..... Pas dans une cellule (mais plutôt sauvagement sur la page, n'importe où !)

Une idée pour résoudre ce problème ??

J'aimerai qu'une image copier d'une cellule C1 se retrouve sur l'autre feuille en cellule C1 également avec la même position ... ??

Merci d'avance.

J'ai également essayer ceci (qui marche plutôt bien mais j'obtiens une erreur sous office 2010 directement sur l'image: "La partie de l'image avec l'ID de relation RId1 n'a pas été trouvé dans le fichier") :

Code :

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

1
2
3
4
5
6
7
                    'Copier/coller des images du range (C:C)
                    Workbooks(2).Sheets("BDD").Activate
                    Columns("C:C").Select
                    Selection.Copy
                    Workbooks(1).Sheets("BDD").Activate
                    Columns("C:C").Select
                    ActiveSheet.Paste

Merci d'avance de votre aide.

Cordialement.

GK

[Ghost0000]

Je me répond à moi même, voici un début de code permettant de faire ce que je souhaite (j'ai des erreurs au niveau des lignes en rouges....car l'image que je copie se nomme par exemple "Image 1" et l'image que je colle se nomme "Image 22"...):

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
                    Dim Nb As String
                    Dim Img As Shape
                    Dim l As String
                    Dim T As String
                    Dim w As String
                    Dim h As String
                    Dim n As String
 
                    With Workbooks(2).Sheets("BDD")
                        Nb = ActiveSheet.Shapes.Count
                            For Each Img In ActiveSheet.Shapes
                                l = Img.Left
                                T = Img.Top
                                w = Img.Width
                                h = Img.Height
                                n = Img.Name
                            Img.Copy
                            Workbooks(1).Sheets("BDD").Paste
                            Workbooks(1).Sheets("BDD").Shapes(n).Left = l
                            Workbooks(1).Sheets("BDD").Shapes(n).Top = T
                            Workbooks(1).Sheets("BDD").Shapes(n).Width = w
                            Workbooks(1).Sheets("BDD").Shapes(n).Height = h
                            Next Img
                    End With

[Ghost0000]

J'ai amélioré le code, j'ai ajouté une ligne, mais cela ne fonctionne toujours pas...

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
25
                    Dim Nb As String
                    Dim Img As Shape
                    Dim l As String
                    Dim T As String
                    Dim w As String
                    Dim h As String
                    Dim n As String

                    With Workbooks(2).Sheets("BDD")
                        Nb = ActiveSheet.Shapes.Count
                            For Each Img In ActiveSheet.Shapes
                                l = Img.Left
                                T = Img.Top
                                w = Img.Width
                                h = Img.Height
                                n = Img.Name
                            Img.Copy
                            Workbooks(1).Sheets("BDD").Paste
                            Workbooks(1).Sheets("BDD").Selection.Name = n
                            Workbooks(1).Sheets("BDD").Shapes(n).Left = l
                            Workbooks(1).Sheets("BDD").Shapes(n).Top = T
                            Workbooks(1).Sheets("BDD").Shapes(n).Width = w
                            Workbooks(1).Sheets("BDD").Shapes(n).Height = h
                            Next Img
                    End With