Code qui fonctionne dans un classeur mais pas dans un autre
Bonsoir a tous,
J'ai testé ce code sur un classeur. Il fonctionne parfaitement.
Code:
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
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
| Sub MAJLogo()
Dim Feuille As Worksheet
Dim Dessin As Shape
Dim Nb As Byte
Dim Hauteur As Integer
Dim Largeur As Integer
Dim Haut As Integer
Dim Gauche As Integer
Dim Boucle As Integer
For Each Dessin In Worksheets("Bases").Shapes
If Dessin.Name = "IMGLogo" Then
Dessin.Select
Dessin.CopyPicture
With Worksheets("Bases").ChartObjects.Add(0, 0, Dessin.Width, Dessin.Height).Chart
'colle l'image dans un graphique temporaire
.Paste
'Sauvegarde au format image, dans le même répertoire que ce classeur.
.Export ThisWorkbook.Path & "\" & Dessin.Name & ".jpeg", "JPEG"
End With
'Supprime le graphique
Nb = Worksheets("Bases").ChartObjects.Count
Worksheets("Bases").ChartObjects(Nb).Delete
End If
Next Dessin
For Each Feuille In ThisWorkbook.Worksheets
If Not Feuille.Name = "Bases" Then
Boucle = 0
For Each Dessin In Feuille.Shapes
If InStr(Dessin.Name, "Logo") <> 0 Then
Boucle = Boucle + 1
Haut = Dessin.Top
Gauche = Dessin.Left
Hauteur = Dessin.Height
Largeur = Dessin.Width
Dessin.Delete
'Insertion d'une nouvelle image
Feuille.Pictures.Insert(ThisWorkbook.Path & "\IMGLogo.jpeg").Name = "Logo" & Boucle
'application des anciens parametres à la nouvelle image
With Feuille.Shapes("Logo" & Boucle)
.Top = Haut
.Left = Gauche
.Height = Hauteur
.Width = Largeur
End With
End If
Next Dessin
End If
Next Feuille
End Sub |
Je l'ai copié dans un autre classeur.
Il bloque à la ligne 17
.paste
avec l'erreur suivante :
Erreur d'execution '1004'
Erreur définie par l'application ou l'objet
Quelqu'un a-t-il une idée ?
Merci
