Incrémentation de Picture

Version imprimable

10/08/2007, 14h46
malabarbe

Incrémentation de Picture

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
10/08/2007, 14h50
jfontaine
Tu peux utiliser une variable i que tu incrémenteras a chaque tours
Code:

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

Merci de ta réponse,

mais cela ne tourne pas !

Voici mon code

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
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

10/08/2007, 15h18
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
10/08/2007, 15h21
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
10/08/2007, 15h25
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é
10/08/2007, 15h29
malabarbe

Citation:

Il te restera lors de l'appel de ta macro de chopper le nom de l'image qui vient d'etre ajouté

Oui, mais comment le chopper ?

et l'inclure dans la macro ?

petite routine qui est peut etre a améliorer
strname retourne a la fin le nom de la dernière Picture inserée (normalement)
Code:

1 2 3 4 5 6 7 8 9 Dim sh As Shape Dim strNom As String For Each sh In Feuil1.Shapes If Left(sh.Name, 7) = "Picture" Then strNom = sh.Name Next sh

10/08/2007, 15h56
malabarbe

Oui, je récupère bien le Picture 6

Mais quand je place la variable dans l'instruction
j'ai une erreur d'exécution

Code:

ActiveSheet.Shapes(" & strNom").Select
10/08/2007, 15h59
jfontaine

Code:

ActiveSheet.Shapes(strNom).Select

PS : pense a utiliser les balises code (le #)
10/08/2007, 16h03
malabarbe

Mille merci,

Cela tourne impec

Bonne soirée