Déplacement d'une image

Version imprimable

Bonjour,

Dans un classeur Excel, sur la feuil1, j'ai une image clipart (Image 1). Je voudrais créer une animation.

Voici le code :

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Sub DéplaceImage(Img As Integer)
Dim i As Integer, T As Double
 
For i = 1 To 26 ' Boucle pour faire une rotation de la voiture.
   ActiveSheet.Shapes(Img).IncrementRotation (i) ' Rotation.
   T = Timer: While T + 0.05 > Timer: Wend ' Pour faire une pause.
   DoEvents                                ' Actualise l'écran.
Next i
ActiveSheet.Shapes(Img).Rotation = 0  ' Remet à 0.
 
For i = 1 To 300 ' Boucle pour déplacer horizontalement la voiture.
   ActiveSheet.Shapes(Img).IncrementLeft 1  ' Déplace d'un pixel à droite.
   T = Timer: While T + 0.01 > Timer: Wend  ' Pour faire une pause.
   DoEvents                                 ' Actualise l'écran.
Next i
 
End Sub

Le problème est que je n'arrive pas à lancer l'animation.

Merci pour votre aide.

Bonjour

il suffit de faire une sub qui appelle ta procédure de type

Code:

1
2
3
4
sub test()
 
call DéplaceImage(1)' 1 est l'idex de l'image sur la feuille
end sub

Sinon, j'ai légèrement modifié ton 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
Sub DeplaceImage2(Img As Shape)
Dim i As Integer, T As Double
 
With Img
    For i = 1 To 26    ' Boucle pour faire une rotation de la voiture.
        .IncrementRotation i    ' Rotation.
        T = Timer: While T + 0.05 > Timer: Wend    ' Pour faire une pause.
        DoEvents                           ' Actualise l'écran.
    Next i
    .Rotation = 0    ' Remet à 0.
 
    For i = 1 To 300    ' Boucle pour déplacer horizontalement la voiture.
        .IncrementLeft 1    ' Déplace d'un pixel à droite.
        T = Timer: While T + 0.01 > Timer: Wend    ' Pour faire une pause.
        DoEvents                            ' Actualise l'écran.
    Next i
End With
End Sub
 
Sub test()
 
DeplaceImage2 Worksheets("Feuil1").Shapes("Image 1")
End Sub

29/11/2016, 17h33
boulser

Merci, problème résolu