Discussion :

[CristofMartins]

Bonjour à tous et à toutes.
J'aimerais savoir si, depuis VBA, peut-on deplacer une image sur Excel. J'aimerais créer une petite animation mais je ne sais pas du tout comment faire ça. si quelque pourrait m'aider.. Merci d'avance

[ninouchfis]

Bonjour, voici un petit code qui fait tourner en rond une image autant de fois que voulu:

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
Sub Bouge_image()
Dim Nom_Image As String
Dim NB_Boucle As Integer
 
    Nom_Image = "Picture 1" 'Nom de l'image
    NB_Boucle = 1 'Nombre de boucle
 
    For i = 1 To NB_Boucle 'Répétition de la boucle en fonction du nombre de boucle paramètré
        ActiveSheet.Shapes(Nom_Image).Select 'Sélection de l'image
 
        Selection.ShapeRange.IncrementLeft 30 'Déplacement de 30 points vers la droite
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementLeft 30 'Déplacement de 30 points vers la droite
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementTop 30 'Déplacement de 30 points vers le bas
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementTop 30 'Déplacement de 30 points vers le bas
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementLeft -30 'Déplacement de 30 points vers la gauche
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementLeft -30 'Déplacement de 30 points vers la gauche
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementTop -30 'Déplacement de 30 points vers le haut
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
 
        Selection.ShapeRange.IncrementTop -30 'Déplacement de 30 points vers le haut
        Application.Wait (Now + TimeValue("00:00:01")) 'Attente d'1 seconde
    Next
 
End Sub