[XL-2007] Macro pour modifier une image

[yvespi]

Bonjour,

J'ai une question toute bête mais pour laquelle, même après avoir passé des heures sur google, je ne trouve pas de solution.

Lorsqu'on a déjà inséré une image dans une feuille excel, en faisant un clique droite dessus, il est possible de la modifier par une autre image. Ça à l'avantage de garder les dimensions de la première image pour la deuxième.

Je souhaiterai faire la même chose mais avec une macro, j'ai donc testé de lancer un enregistrement de macro, de faire la manip et de regarder le code qui correspond à cette manip. Mais il se trouve que sur excel 2007, l'enregistrement n'enregistre rien pour tout ce qui touche aux graphiques ou aux images...

J'ai donc réinstallé une version 2003 de excel pour faire exactement la même chose, récupérer le code et le mettre dans ma macro sous 2007. La problème que j'ai maintenant c'est que sous 2003, la fonction "modifier l'image" n'a pas l'air d'exister!

Est ce que quelqu'un pourrait m'aider?
Soit en me donner le code pour modifier l'image, ou soit en me disant comment activer, si c'est possible, cette fonction sous 2003

Merci d'avance

yvespi

[Daniel.C]

Bonjour,

Apparemment, il n'y a pas de commande équivalente en VBA. J'ai trouvé le code suivant sur internet qui consiste à noter la position et les dimensions de l'image, à supprimer l'image et à en insérer une nouvelle en appliquant les mesures faites sur la première :

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
Sub Change_Picture_Location()
'Error Handler
On Error GoTo ErrH:
 
'Declaration of Variables
Dim flag As Boolean
Dim myShape As Shape
Dim cTop As Double
Dim cLeft As Double
Dim cHeight As Double
Dim cWidth As Double
' +-+- Check whether Selection is Shape or Range -+-+
flag = False
For Each myShape In ActiveSheet.Shapes
    If myShape.Name = Selection.Name Then
        flag = True
        Exit For
    Else
        flag = False
    End If
Next
ErrH:
On Error GoTo endH
' +-+- Checking Over -+-+
If flag = True Then
'Saving Selected Image Attributes
    cTop = Selection.ShapeRange.Top
    cLeft = Selection.ShapeRange.Left
    cHeight = Selection.ShapeRange.Height
    cWidth = Selection.ShapeRange.Width
'Delete Selected Image
    Selection.Delete
 
'Insert New Image
    ActiveSheet.Pictures.Insert(Application.GetOpenFilename).Select
 
'Applying Old attributes to the New image
    Selection.ShapeRange.Top = cTop
    Selection.ShapeRange.Left = cLeft
    Selection.ShapeRange.Height = cHeight
    Selection.ShapeRange.Width = cWidth
Else
    MsgBox "Please select a picture not the range."
End If
endH:
End Sub