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.

 

[CISCO]

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

Bonsoir à tous

Je viens de tester ta solution, Job75, ainsi que la proposition de Si, sur deux fichiers différents. Ca a fonctionné une fois, et maintenant, je n'arrive plus à exécuter les macros en question. J'essaye sur un autre ordi dès que possible.

@ plus

 

[CISCO]

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

Bonsoir

Bon, et bien, je viens d'essayer sur un autre ordi. C'est étrange. Cela ne fonctionne pas, aussi bien avec la proposition de Job75 qu'avec celle de Si. Lorsque je cherche à sortir de la macro avec Echap, les photo s'affichent toutes les unes sur les autres très rapidement dans le premier cas, les unes après les autres dans le second cas, un peu plus lentement. Pourquoi est-ce qu'il faut appuyer sur Echap ?

Je regarde les autres possibilités demain.

@ plus

 

[Lone-wolf]

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

Bonsoir à tous,

CISCO as-tu testé la macro que j'ai proposé ou le fichier que j'ai mis?


A+

 

[CISCO]

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

Bonjour à tous

@ Lone-wolf : Non, cela bogue sur la ligne Feuil1.Image1.Picture = LoadPicture(repertoire & NomPhoto) avec le message "Erreur 76" (j'ai essayé avec différentes adresses de répertoire). Il y a peut-être, certainement quelque chose que je ne fais pas correctement.

@ plus

 

[job75]

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

Bonjour CISCO, le forum,

Je n'avais pas fait attention, mais quand tu écris au post #1 pas = 10 il s'agit de jours !!!

Pour obtenir des secondes il faut écrire dans l'autre macro :

Application.Wait(Now + pas/86400)

Bonne journée.

 

[CISCO]

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

Bonjour

@ Job75 : J'ai lu quelque part que le temps était à donner en seconde avec Wait, d'où mon erreur précédente (D'ailleurs, c'est plus pratique que cela soit en jour, comme avec les formules).

Ceci dit, la macro ne fonctionne pas si je passe par répertoirePhoto et fichier. Elle bloque sur la ligne

Set img = ActiveSheet.Pictures.Insert(répertoirePhoto & fichier & (100 + p) & ".jpg")

J'ai essayé en ne remplaçant que répertoirePhoto, ou que fichier, mais cela ne passe pas.

Par contre, si j'écris l'adresse totale entre ces parenthèse

Set img = ActiveSheet.Pictures.Insert("C:\Users\.........\à peindre2\" & "DSC_0" & (100 + p) & ".jpg")

cela fonctionne.

Je ne comprend pas trop pourquoi, mais bon...

Merci.

@ plus

P.S : Bien sûr, cela fonctionne aussi avec la proposition de Si... en écrivant l'adresse complète entre les parenthèses.

 

[Lone-wolf]

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

Bonjour à tous

@ Lone-wolf : Non, cela bogue sur la ligne Feuil1.Image1.Picture = LoadPicture(repertoire & NomPhoto) avec le message "Erreur 76" (j'ai essayé avec différentes adresses de répertoire). Il y a peut-être, certainement quelque chose que je ne fais pas correctement.

@ plus

I CISCO

tu as initialiser les variables? Sinon regarde bien dans le fichier que j'ai mis. Moi au départ j'avais oublié aussi de le faire et ça me fesait une erreur. C'est peut-être ça.

Et encore une fois, à moins de dire une grosse connerie; c'est n'est pas mieux loader qu'inserer?





A+

 

[CISCO]

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

Bonjour

Qu'est-ce que tu appelles "initialiser les variables" dans ce cas ?

@ plus

 

[Lone-wolf]

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

Re CISCO

Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.DisplayAlerts = False
ActiveWorkbook.Save
End Sub

Private Sub Workbook_Open()
 répertoire = ThisWorkbook.Path
  NomPhoto = Dir(répertoire & "\" & "*.jpg")
 Call majHeure
End Sub



Public Const repertoire As String = "C:\Users\CISCO\Desktop\Nouveau dossier\"
Public NomPhoto
Public temps
Sub majHeure()
 Feuil1.Image1.Picture = LoadPicture(repertoire & NomPhoto)
  NomPhoto = Dir
 If NomPhoto = "" Then NomPhoto = Dir(repertoire & "*.jpg")
 temps = Now + TimeValue("00:00:03")
 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("00:05:00"), "Arret"
End Sub

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

Est-ce que tu as fait la même chose, moi en plus j'y ai rajouté une mélodie de fond. Mais j'ai un petit souci. Si je clique sur le bouton pour tout arrêter, pas de problème. Mais je n'arrive pas à faire en sorte qu'après un certain temps ça s'arrête tout seul (surtout le diaporama).



A+

 

[CISCO]

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

Bonsoir

@ Lone-Wolf : Dans ta macro, je ne vois où tu appelles la macro horloge !

@ plus

 

[Lone-wolf]

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

Bonjour CISCO,

Désolé un oubli de ma part, à ne pas prendre en compte. C'était la sub qui devait arrêter tout sans mon intervention mais elle ne fonctionne pas.



A+

 

[Lone-wolf]

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

Re Cisco,

Il y a ceci a supprimer vu que c'est la constante repertoire qui permet de charger les images.

répertoire = ThisWorkbook.Path

Et Pour Marche Arrêt à appeler par bouton ou par formes

Dim flag as Boolean

Sub OnOff()
Call Arreter
  Call PlaySound(&H1, 0&, SND_ASYNC Or SND_FILENAME)
    If flag Then
        flag = False
  NomPhoto = Dir(repertoire & "*.jpg")
 Call majHeure
Son = "amore-grande.wav"
WavFile = repertoire & Son
Call PlaySound(WavFile, 0&, SND_ASYNC Or SND_FILENAME)
        End
    End If
        flag = True
Do
If flag Then Exit Do
DoEvents
Loop
End Sub

 

[CISCO]

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

Bonjour à tous, bonjour Lone-Wolf

J'ai essayé d'implanter tes propositions sur mon fichier, mais cela ne fonctionne pas. Cela semble tourner en pas à pas détaillé, mais je n'ai rien à l'écran. Faut dire que c'est vraiment du bricolage de ma part car je n'y comprend pas grand chose : Pourquoi est-ce que telle partie est dans un module, telle autre dans Thisworkbook... ? Je n'ai pas ton niveau... Je le fais maintenant surtout histoire de comprendre un peu mieux comment cela fonctionne. Si tu n'en as pas le temps, ne te prends la tête avec ce pb, puisque j'ai réussi à faire avec les propositions de Job75 ou de Si...

Je te met en pièce jointe mon fichier dans son état actuel pour que tu te rendes compte du bricolage en question !

@ plus

 

[Lone-wolf]

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

Bonsoir CISCO,

J'ai vu que dans Workbook_Open() tu as Thisworkbook.Path; il faut que tu mette repertoire à la place.

Si tu n'utilise aucun fichier audio, supprime tous ce qui touche à Playsound.

Je viens de faire un test, j'ai bien les images qui défilent.

Dim flag as Boolean

Sub OnOff()
Call Arreter
    If flag Then
        flag = False
  NomPhoto = Dir(repertoire & "*.jpg")
 Call majHeure
        End
    End If
        flag = True
Do
If flag Then Exit Do
DoEvents
Loop
End Sub

Quand tu aura modifier ce que j'ai dit plus haut. Ferme le classeur ensuite tu l'ouvre. Là, normalement les images devraient défiler. La Sub OnOff() au premier clic du bouton va te permettre d'arrêter le défilement et un 2ème clic de le remettre en marche.





A+

 

[Lone-wolf]

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

Re CISCO,

Le fichier corrigé. Modifie juste le chemin des images - enregistre et ferme le classeur, ensuite tu l'ouvre. Normalement les images devraient défiler.



A+