Démarrer une animation VBA à l'ouverture d'un classeur

Bonjour,

C’est ma première demande sur le forum qui m’a déjà beaucoup aidé.

J’en profite pour remercier les experts qui aide les moins expérimenté dont je fais partie.

J’ai développé, à l’aide d’un tuto, une macro-animation (une image qui se déplace et souhaite le bonjour pour finir). Elle fonctionne parfaitement si elle est activée par un bouton de commande.

Je voudrai quelle démarre, si c’est possible, à l’ouverture d’un classeur.

J’ai appelé (call) la macro a l’activation de la feuille, mais elle ne fonctionne pas.

Merci d’avance.

Bonjour,

Pour qu'une macro se lance automatiquement à l'ouverture du fichier, il faut que tu écrives celles-ci dans le module thisworkbook.

Ensuite le code doit commencer par :Private Sub Workbook_Open() et la macro s'effectuera à chaque ouverture du fichier.

Belle journée à vous.

Bonjour,

Merci pour ta réponse et désolé pour ma réponse tardive due à un problème familial.

J’ai mis comme demander le code dans le module thisworkbook (la figure qui s'anime est dans la Sheet B2). Ca fonctionne pas.

   Private Sub Workbook_Open()
    Sheets("B1").Activate
    Sheets("B2").Activate
    Dim Repetition As Integer
    Repetition = 0
    Do
        DoEvents
        Repetition = Repetition + 1
        Sheets("B2").Shapes("Bout").Left = Repetition
        Sheets("B2").Shapes("Bout").Top = 30
        'Elargir
        Sheets("B2").Shapes("Bout").Width = Repetition
        'Agrandir
        Sheets("B2").Shapes("Bout").Height = Repetition
        'Pivoter
        Sheets("B2").Shapes("Bout").Rotation = Repetition
    Animation (0.01)
    Loop Until Repetition = 360

   End Sub
Sub Animation(Duree As Double)
    Dim Debut As Double
    Debut = Timer 'timer affi c her nb seconde écoulee depuis minuit
        Do
            DoEvents 'suspendre
        Loop Until (Timer - Debut) >= Duree
End Sub

J'ai essayer aussi. Ca fonctionne pas.

   Private Sub Workbook_Open()
    Sheets("B1").Activate
    Sheets("B2").Activate
    Call Anime_Smiley
   End Sub
Sub Animation(Duree As Double)
    Dim Debut As Double
    Debut = Timer 'timer affi c her nb seconde écoulee depuis minuit
        Do
            DoEvents 'suspendre
        Loop Until (Timer - Debut) >= Duree
End Sub

Sub Anime_Smiley()
    Dim Repetition As Integer
    Repetition = 0
    Do
        DoEvents
        Repetition = Repetition + 1
        Sheets("B2").Shapes("Bout").Left = Repetition
        Sheets("B2").Shapes("Bout").Top = 30
        'Elargir
        Sheets("B2").Shapes("Bout").Width = Repetition
        'Agrandir
        Sheets("B2").Shapes("Bout").Height = Repetition
        'Pivoter
        Sheets("B2").Shapes("Bout").Rotation = Repetition
    Animation (0.01)
    Loop Until Repetition = 360
End Sub
comme déjà signalé, l'anim fonctionne super si commandée par un bouton ActiveX
J'ai probablement pas compris donc Help! et encore merci
philippeBe

Bonjour,

Merci pour ta réponse et désolé pour ma réponse tardive due à un problème familial.

J’ai mis comme demander le code dans le module thisworkbook (la figure qui s'anime est dans la Sheet B2). Ca fonctionne pas.

   Private Sub Workbook_Open()
    Sheets("B1").Activate
    Sheets("B2").Activate
    Dim Repetition As Integer
    Repetition = 0
    Do
        DoEvents
        Repetition = Repetition + 1
        Sheets("B2").Shapes("Bout").Left = Repetition
        Sheets("B2").Shapes("Bout").Top = 30
        'Elargir
        Sheets("B2").Shapes("Bout").Width = Repetition
        'Agrandir
        Sheets("B2").Shapes("Bout").Height = Repetition
        'Pivoter
        Sheets("B2").Shapes("Bout").Rotation = Repetition
    Animation (0.01)
    Loop Until Repetition = 360

   End Sub
Sub Animation(Duree As Double)
    Dim Debut As Double
    Debut = Timer 'timer affi c her nb seconde écoulee depuis minuit
        Do
            DoEvents 'suspendre
        Loop Until (Timer - Debut) >= Duree
End Sub

J'ai essayer aussi. Ca fonctionne pas.

   Private Sub Workbook_Open()
    Sheets("B1").Activate
    Sheets("B2").Activate
    Call Anime_Smiley
   End Sub
Sub Animation(Duree As Double)
    Dim Debut As Double
    Debut = Timer 'timer affi c her nb seconde écoulee depuis minuit
        Do
            DoEvents 'suspendre
        Loop Until (Timer - Debut) >= Duree
End Sub

Sub Anime_Smiley()
    Dim Repetition As Integer
    Repetition = 0
    Do
        DoEvents
        Repetition = Repetition + 1
        Sheets("B2").Shapes("Bout").Left = Repetition
        Sheets("B2").Shapes("Bout").Top = 30
        'Elargir
        Sheets("B2").Shapes("Bout").Width = Repetition
        'Agrandir
        Sheets("B2").Shapes("Bout").Height = Repetition
        'Pivoter
        Sheets("B2").Shapes("Bout").Rotation = Repetition
    Animation (0.01)
    Loop Until Repetition = 360
End Sub
comme déjà signalé, l'anim fonctionne super si commandée par un bouton ActiveX
J'ai probablement pas compris donc Help! et encore merci
philippeBe

Bonjour,

Essayer ce code la modification est légère mais si votre code fonctionne avec un bouton il n'y a pas de raisons que celui ci ne fonctionne pas.

   Private Sub Workbook_Open()
    Sheets("B1").Activate
    Sheets("B2").Activate
    Anime_Smiley
   End Sub
Sub Animation(Duree As Double)
    Dim Debut As Double
    Debut = Timer 'timer affi c her nb seconde écoulee depuis minuit
        Do
            DoEvents 'suspendre
        Loop Until (Timer - Debut) >= Duree
End Sub

Sub Anime_Smiley()
    Dim Repetition As Integer
    Repetition = 0
    Do
        DoEvents
        Repetition = Repetition + 1
        Sheets("B2").Shapes("Bout").Left = Repetition
        Sheets("B2").Shapes("Bout").Top = 30
        'Elargir
        Sheets("B2").Shapes("Bout").Width = Repetition
        'Agrandir
        Sheets("B2").Shapes("Bout").Height = Repetition
        'Pivoter
        Sheets("B2").Shapes("Bout").Rotation = Repetition
    Animation (0.01)
    Loop Until Repetition = 360
End Sub

Bonjour,

Ca fonctionne Un tout grand merci

philippeBe

J'ai pas compris comment faire "Résolu"

Pas de soucis.

Pour marquer un sujet comme résolut il suffit de de cliquer sur la flèche en bas à droite du message qui vous a résolu le soucis.