Diaporama, défilement de photographies sur une feuille

[CISCO]

Bonsoir à tous

En m'aidant des propositions de J. Boisgontier sur son site, j'ai essayé de faire un petit diaporama faisant défiler des photos allant de DSC_0101 à DSC_0104 prises dans le dossier "à peindre2".

Voila macro

Dim p As Integer, pas As Integer, temps As Date, fichier as String, répertoirePhoto As String
-----------
Sub Début()
  répertoirePhoto = "C:\Users\à peindre2\" ' A adapter à chaque cas
  fichier = "DSC_0" 'A Adapter à chaque cas
  pas = 10
  majHeure
End Sub
----------
Sub majHeure()
  For p = 1 To 4
  Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & fichier & 100 + p & ".jpg")
  Application.Wait (Now + pas)
  Next
End Sub
----------
Sub auto_close()
 On Error Resume Next
 Application.OnTime temps, Procedure:="majHeure", Schedule:=False
End Sub

Cela fonctionne, mais plus je fais des tests, plus cela rame. Les deux, trois premières fois, c'est OK, mais après, c'est long, c'est long... Si je copies le code et le mets dans un autre fichier, cela fonction correctement au début, puis cela rame de nouveau...

Est-ce que vous auriez une explication, une ou des améliorations à me proposer...

@ plus

P.S : Si vous voulez tester le fichier en pièce jointe, il faut modifier le chemin d'accès et le nom du fichier.

 

[job75]

Re : Diaporama, défilement de photographies sur une feuille

Bonsoir CISCO,

Les Pictures pèsent lourd et s'accumulent les unes sur les autres.

En les supprimant avant chaque diaporama (ou à la fin) cela devrait aller mieux :

Sub majHeure()
  ActiveSheet.DrawingObjects.Delete
  For p = 1 To 4
  Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & fichier & 100 + p & ".jpg")
  Application.Wait (Now + pas)
  Next
End Sub

A+

 

[Lone-wolf]

Re : Diaporama, défilement de photographies sur une feuille

Bonsoir CISCO, job

je me souvenait de la macro, mais comme Jacques j'avais créé un formulaire avec 14 images sans numérotation.

Peut-être que ça pourras t'aider.

Public temps, répertoire, NomPhoto

Sub majHeure()
 UserForm1.Image1.Picture = LoadPicture(répertoire & "\" & NomPhoto)
 NomPhoto = Dir
 If NomPhoto = "" Then NomPhoto = Dir(répertoire & "\" & "*.jpg")
 temps = Now + TimeValue("00:00:6")
 Application.OnTime temps, "majHeure"
End Sub

Sub auto_close()
 On Error Resume Next
 Application.OnTime temps, Procedure:="majHeure", Schedule:=False
End Sub

Sub horloge()
Application.OnTime Now + TimeValue("01:00:00"), "Arret"
End Sub

Sub Arret()
auto_close
Unload UserForm1
Application.DisplayAlerts = False
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
  auto_close
End Sub

Private Sub UserForm_Terminate()
Run ("Arret")
End Sub

Peut-être avec un contrôle image ou WebBrowser ça passerait mieux, c'est juste une opinion.




A+ 😎

 

[Lone-wolf]

Re : Diaporama, défilement de photographies sur une feuille

Bonsoir CISCO, job


Et voilà, chez moi pas de souci d'attente, à tester. Dans la macro post #3, comme je n'avais pas regardé le fichier comme il faut, je n'avais pa vu qu'il fallait initialiser les variables, voir la PJ.



A+ 😎

 

[CISCO]

Re : Diaporama, défilement de photographies sur une feuille

Bonjour à tous, bonjour Job75 et Lone-Wolf

Merci pour vos propositions. Je regarde ça dès que possible.

@ plus

 

[Lone-wolf]

Re : Diaporama, défilement de photographies sur une feuille

I CISCO 🙂

@ plus

Mince!! Je me défend en math, mais la je câle... @ plus ça donne quoi?! 😕 😉


A+ 😎

 

[Si...]

Re : Diaporama, défilement de photographies sur une feuille

salut

Avec peu d'images , on peut les transférer directement dans le classeur* à partir d'un contrôle ImageList dans un formulaire (macro légère).

Private Sub UserForm_Activate()
 Dim n As Byte, temp As Date
  For n = 1 To 4
    Me.Caption = "photo " & n
    Image1.Picture = ImageList1.ListImages(n).Picture
    temp = Timer
    Do: DoEvents:: Loop While Timer < temp + 2
  Next
  End
End Sub

* portabilté accrue : plus besoin de les rechercher sur le disque (surtout si elles ont été supprimées)

 

[job75]

Re : Diaporama, défilement de photographies sur une feuille

Bonjour le fil,

Curieux que ni Lone-wolf ni Si... ne répondent au problème posé :

plus je fais des tests, plus cela rame

Moi j'ai répondu ou essayé de répondre 🙄

A+

 

[Lone-wolf]

Re : Diaporama, défilement de photographies sur une feuille

Bonjour job, Si...


@job: Si... 😉 j'ai répondu au problème avec le fichier proposé et Si... aussi.


A+ 😎

 

[job75]

Re : Diaporama, défilement de photographies sur une feuille

Re Lone-wolf,

Bah CISCO travaille sur une feuille et pas dans un UserForm 🙄

A+

 

[Si...]

Re : Diaporama, défilement de photographies sur une feuille

re

Bonjour le fil,
Curieux que ni Lone-wolf ni Si... ne répondent au problème posé :
Moi j'ai répondu ou essayé de répondre 🙄
A+

Job, on sait que tu es le meilleur malheureusement les codes coincent chez moi ! 😡

De plus, avec ton instruction supplémentaire, tous les contrôles de la feuille sont supprimés. Il y en a peut-être d'autres utiles, non ? Je pense, aussi qu’elle est mal placée !

Pour avoir un résultat correct à partir les codes fournis j’y arrive, chez moi, avec seulement cela

Sub Début()
  répertoirePhoto = "…\" 'A Adapter à chaque cas
  fichier = "…" ' A Adapter à chaque cas
  For p = 0 To 3
  ActiveSheet.DrawingObjects.Delete 'plus efficace ici
  Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & fichier & p & ".jpg")
   temp = Timer :  Do: DoEvents: Loop While Timer < temp + 2 'chercher l'erreur ...
  Next
End Sub

C'est quand même gros de voir un tel message quand on veut proposer des solutions peut-être préférables à celles testées au départ ! 😡

 

[Lone-wolf]

Re : Diaporama, défilement de photographies sur une feuille

Re job,

Non, mon dernier fichier est fait sur la feuille. 😉


@Cisco: tu veux bien ajouter la version d'Excel que tu utilise, ainsi les autres s'adaptent. 😉
Et Si... aussi please 😉




A+ 😎

 

[job75]

Re : Diaporama, défilement de photographies sur une feuille

De plus, avec ton instruction supplémentaire, tous les contrôles de la feuille sont supprimés. Il y en a peut-être d'autres utiles, non ?

J'ai de bonnes lunettes et j'avais vu que dans le fichier du post #1 CISCO n'a pas mis de boutons ou autres contrôles.

Maintenant s'il veut en mettre, il faudra faire une boucle vérifiant que l'objet est une "picture" pour le supprimer.

A+

 

[CISCO]

Re : Diaporama, défilement de photographies sur une feuille

Bonjour à tous

Vous disputez pas, les copains... Je n'ai pas d'autres boutons sur la feuille en question, donc...

J'essaye de comprendre vos diverses propositions.

@ plus

 

[job75]

Re : Diaporama, défilement de photographies sur une feuille

Bonsoir,

Bon CISCO, j'aimerais bien savoir si ma proposition du post #2 améliore la situation.

Il faut 5 minutes pour tester...

Bonne fin de soirée.