Discussion :

[malabarbe]

Bonjour,

Grace au forum, ma macro pour redimentionner un image
tourne impec !

Un petit soucis, c'est quand j'ai fait un couper coller de
l'image dans une autre feuille, après, je retourne dans la
feuille qui contient la macro ensuite j'insert une autre
image, et la, quand je lance la macro j'ai une erreur car
l'instruction :
ActiveSheet.Shapes("Picture 1").Select
le nom de l'image est passé à Picture 2

Comment incrémenter le Picture ou
comment effacer l'historique des images chargées ?

Merci de votre aide

[jfontaine]

Tu peux utiliser une variable i que tu incrémenteras a chaque tours

Code :

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

1
2
3
4
5
 
dim i as integer
 
i=i+1
ActiveSheet.Shapes("Picture " & i).Select

[malabarbe]

Merci de ta réponse,

mais cela ne tourne pas !

Voici mon code

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
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
52
53
54
55
Sub Miniature()
 
Dim I As Integer
I = 1
 
On Error GoTo err1
 
'Pivote l'image = OK
 ActiveSheet.Shapes("Picture &I").Select
 'Selection.ShapeRange.IncrementRotation 90#
 
'Redimentionne l'image
ActiveSheet.Shapes("Picture &I").Select   '
 
'Selection.ShapeRange.ScaleWidth 1.31, msoFalse, msoScaleFromTopLeft
 
  Dim Image As Object
        Dim Position As Range
        Set Position = Cells(1, 1)
        Set Image = ActiveSheet.Shapes("Picture &I")
            With Image
                .LockAspectRatio = msoTrue
                .Left = Position.Left
                .Top = Position.Top
                .Height = Position.Height
                .Width = Position.Width
            End With
 
 'Pivote l'image = OK
 ActiveSheet.Shapes("Picture &I").Select
 Selection.ShapeRange.IncrementRotation 90#
 
        Set Position = Cells(2, 1)
        Set Image = ActiveSheet.Shapes("Picture &I")
            With Image
                .LockAspectRatio = msoFalse
                .Left = Position.Left
                .Top = Position.Top
                .Height = Position.Height
                .Width = Position.Width
            End With
 
'Positionne l'image = OK
 ActiveSheet.Shapes("Picture &I").Select
 Selection.ShapeRange.IncrementLeft -2000
 Selection.ShapeRange.IncrementTop -2000
 
GoTo Fin
 
err1:
      I = I + 1
      Resume Next
 
Fin:
    End Sub

[jfontaine]

tu n'as pas de boucle dans ton code.
Il n'a aucune utilité dans ce cas

De plus le traitement entre le Picture 1 et Picture 2 ne semble pas identique donc il te faut laisser ton code comme il etait

[malabarbe]

Si, tous les traitements de la macro
concernent la mème image

C'est seulement quand j'insère une novelle image,
il faudrais incrémenter Picture dans toute la macro

[jfontaine]

ah ok.
Dans ce cas passe le nom de l'image en paramètre lors de l'appel de ta macro et utilises ce nom dans ton code.
Il te restera lors de l'appel de ta macro de chopper le nom de l'image qui vient d'etre ajouté