Capturer les images d'une WebCam

MichelXld

XLDnaute Barbatruc
Bonjour


Ce classeur permet de capturer les images perçues par la WebCam lors du clic sur un bouton ,( mais pas de visualiser en 'temps réel' ce que voit la caméra . )
Les images sont colléees dans l'USF grace à la méthode PastePicture , de Stephen Bullen
La WebCam doit etre branchée avant d'afficher l'USF

Une option permet d'enregistrer l'image capturée , sur le disque dur , dans le meme repertoire que ce classeur
, au format '\\ImageWebCam' & Format(Date, 'YYYYMMDD') & ' ' & Format(Time, 'HHMMSS') & '.jpg'

testé avec une WebCam Logitech QuickCam Home 1.02
sous WinXP & Excel2002 ( necessite la DLL avicap32.dll )

Les sources :
http://www.vbfrance.com/code.aspx?ID=30202
TheHacker & Sylvain298

http://www.bmsltd.ie/Excel/Default.htm
Stephen bullen
( pour la procédure PastePicture )


en espérant que cela interesse quelqu'un ( et que ça fonctionne chez vous )
tous vos retours de tests m'interessent



bon dimanche
MichelXld [file name=XLD_WebCamCapture.zip size=34462]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/XLD_WebCamCapture.zip[/file]
 

Pièces jointes

  • XLD_WebCamCapture.zip
    33.7 KB · Affichages: 1 507

CBernardT

XLDnaute Barbatruc
Bonjour Michel et Eric C,

C'est vraiment super !

Testé avec Philips ToUcam Pro , Win XP et XL 2003 cela fonctionne très bien.

Toutes les commandes sont au rendez-vous.

Un petit bémol, c'est de ne pas pouvoir, comme tu le dis, ' visualiser en 'temps réel' ce que voit la caméra'.

Je pense aussi que pour permettre d'enregistrer où bon nous semble, il serait facile de faire apparaître la fenêtre 'enregistrer sous'.

Beau travail !

Bonnes fêtes de Pâques

Cordialement

CBernardT
 

Celeda

XLDnaute Barbatruc
Bonjour le Forum,

COmme Eric, je trouve cela G E N I A L et pour te le prouver je me suis amusée à me tirer toute une série de portraits selon mon meilleur profil :) avec ma webcam et cela fonctionne parfaitement et je t'envoie une de mes photos. Bon d'accord, j'aurai pu la joindre au USF mais je voulais savoir si je pouvais faire des insertions un peu partout et donc comme Bernard, un enregistrer sous serait le bienvenu!!!car je te dis pas où jai dû retrouver mes exemplaires d'images et quand j'ai voulu sauvegarder, il me proposait :

Bin: programfiles/frontpage/version3.0/bin!!!!

donc mimi je t'embrasse très fort !!!!!!

et grâce à toi on va peut-être pouvoir se faire un trombinoscope de toutes et tous avec nos webcams respectives et on demandera à David de nous ouvrir une autre porte pour qu'on le mette dedans!!!!

et ........te soupconnerais-je de l'avoir fait exprès cette démo :) :) :) !!!!!pour voir nos trombines!!!

qu'est-ce qu'on est gâté avec vous messieurs et dames, entre les supers mégas usf-démos, et ces petits 'joujoux' sans oublier tous ces fichiers démos de changement de couleur, de décompte de jours, et j'en oublie certainement des excellents et fins et discrets fichiers, cela vaut bien un grand remerciement que je vous offre de tout mon coeur.

Celeda :kiss: [file name=Webcamceleda0.zip size=42214]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/Webcamceleda0.zip[/file]
 

Pièces jointes

  • Webcamceleda0.zip
    41.2 KB · Affichages: 544

Pierre

XLDnaute Occasionnel
Re,


Celeda tu es.... un coeur.

Moi j'ai quand même eu un p'tit soucis. L'image a tendance à me rajeunir, mais je n'ai pas trouvé le code qui permettait cela. Un vrai magicien ce Michel
(A moins que ce ne soit réservé aux plus coquettes des membres féminins (non ce n'est pas antinomique :)) de notre superbe forum)


Pierre [file name=webcamresult.zip size=48637]http://www.excel-downloads.com/components/com_simpleboard/uploaded/files/webcamresult.zip[/file]
 

Pièces jointes

  • webcamresult.zip
    47.5 KB · Affichages: 418

john

XLDnaute Impliqué
Re : Capturer les images d'une WebCam

Bonjour,

Je sais que ce post date depuis pas mal de temps, mais je viens seulement de le découvrir vu que je recherchais seulement maintenant de pouvoir gérer ma webcam via excel.

Je viens de prendre le fichier ci-dessus (XLD_WebCamCapture.zip‎) et comme l'ont dis les autres, GENIALLLLLLLL.
Mais je voulais quand même avoir un semblant de webcam et pouvoir visualiser en "live" ma webcam, donc je me suis penché sur le problème (je ne sais pas si celà a déjà été fait par la suite car je n'ai pas cherché plus loin vu que j'avais trouvé ce qu'il me fallait pour commencer.

Donc je disais que je me suis penché sur le problème et j'ai trouvé une solution pour faire afficher ma webcam en "live" avec le code qui se trouve dans le fichier (XLD_WebCamCapture.zip‎).

Je me permet de mettre le code modifié ici et qui sait... en faire profiter d'autre car apparemment avec office 2010 il n'y a pas le contrôle supplémentaire "videopreview"

Private Sub UserForm_Activate()
On Error Resume Next ' j'ai ajouté cette ligne
'recuperer le Handle de l'Usf : Daniel Klann, mpep
If Val(Application.Version) < 9 Then 'Excel 2000
strFormClassName = "ThunderXFrame"
Else
strFormClassName = "ThunderDFrame" 'Excel 2000/2002
End If

Valeur = FindWindow(strFormClassName, "UserForm1") 'le Handle de la fenetre

'on definie la variable necessaire au bon fonctionnement de la capture video
mCapHwnd = capCreateCaptureWindow("My Own Capture Window", 0, 0, 0, 320, 240, Valeur, 0)
'on dit au prog que la camera est branchée
SendMessage mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0

If SendMessage(mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0) = 0 Then
MsgBox ("La camera n'est pas connectée")
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)
Unload Me
Else ' j'ai ajouté cette ligne
I = 1' j'ai ajouté cette ligne
Do' j'ai ajouté cette ligne
If I Mod 1000 = 0 Then ' Lorsque la boucle s'est ' j'ai ajouté cette ligne
' répétée 1000 fois. ' j'ai ajouté cette ligne
DoEvents ' Cède le contrôle au ' j'ai ajouté cette ligne
' système d'exploitation. ' j'ai ajouté cette ligne
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0 'on rafraichit l'image "webcam" ' j'ai ajouté cette ligne
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0 ' j'ai ajouté cette ligne
Set Image1.Picture = PastePicture(WM_CAP_EDIT_COPY)' j'ai ajouté cette ligne
End If' j'ai ajouté cette ligne
End If
I = I + 1 ' j'ai ajouté cette ligne ==> en fait je me sert de I pour pouvoir quitter la boucle quand on clique sur la croix, je l'initialise à -1 car vu qu'ici il va faire +1 i=0 sinon le programme se ferme mais ne se coupe pas à cause du DoEvents
Loop Until I = 0
End If
End Sub
'-------------------------------------------------------------------
' dans la procédure termiate, j'ai ajouté 2 commandes
'-------------------------------------------------------------------
Private Sub UserForm_Terminate()
Dim oDataObject As DataObject

'Etape Importante avant de quitter sinon ca peut bloquer !
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)

Set oDataObject = New DataObject 'vider le presse papier
oDataObject.SetText ""
oDataObject.PutInClipboard

Set oDataObject = Nothing
Unload Me 'j'ai ajouté cette ligne
I = -1 'j'ai ajouté cette ligne
End Sub

J'espère que ça pourra aider quelqu'un :)

Bien à vous et bonne journée.

John
 

c_cool_la_vie

XLDnaute Nouveau
Re : Capturer les images d'une WebCam

Bonjour @ tous,
Merci infiniment Michel pour ce code si précieux.
Je me permets d'ajouter une simplification car à la première connexion, ça plante en caméra non détectée. J'ai ajouté une boucle de 4 tentatives de connexion qui suffisent à faire fonctionner le code à chaque fois. Et aussi un petit code "all in one" pour prendre et enregistrer une photo d'un simple clic, sans ouvrir la fenêtre Userform :

Sub Lance_et_snapshot()
'xld_WebCamCapture de michelxld
'sur Excel Downloads
'adapté par c_cool_la_vie le 21/03/2016
'
On Error Resume Next
Dim etat As Integer
Dim loop_test As Integer

For loop_test = 1 To 4

If Val(Application.Version) < 9 Then 'Excel 2000
strFormClassName = "ThunderXFrame"
Else
strFormClassName = "ThunderDFrame" 'Excel 2000/2002
End If
'UserForm1.Show
Valeur = FindWindow(strFormClassName, "UserForm1") 'le Handle de la fenetre

'on definie la variable necessaire au bon fonctionnement de la capture video
mCapHwnd = capCreateCaptureWindow("Sample picture", 0, 0, 0, 640, 480, Valeur, 0)

'on dit au prog que la camera est branchée
etat = SendMessage(mCapHwnd, WM_CAP_DRIVER_CONNECT, 0, 0)

If etat = 0 Then
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)
If loop_test = 4 Then
MsgBox ("La camera n'est pas connectée")
Exit Sub
End If
' Exit Sub
Else
'Si succès : arrêt de la boucle
loop_test = 4
End If

Next loop_test


Dim oDataObject As DataObject
Dim iPic As StdPicture, Echantillon As String
SendMessage mCapHwnd, WM_CAP_GRAB_FRAME, 0, 0 'on rafraichit l'image "webcam"
SendMessage mCapHwnd, WM_CAP_EDIT_COPY, 0, 0
Set iPic = PastePicture(WM_CAP_EDIT_COPY)
If iPic Is Nothing Then Exit Sub

Echantillon = ""
Echantillon = InputBox("Nom du fichier à enregistrer ?", "Enregistrement photo")

SavePicture iPic, ThisWorkbook.Path _
& "\" & Echantillon & " - " & Format(Date, "YYYY-MM-DD") & " " & Format(Time, "HH-MM-SS") & ".jpg"

DestroyIcon iPic.handle
Set iPic = Nothing

'Etape Importante avant de quitter sinon ca peut bloquer !
retvale = SendMessage(mCapHwnd, WM_CAP_DRIVER_DISCONNECT, 0, 0)
DestroyWindow (mCapHwnd)

Set oDataObject = New DataObject 'vider le presse papier
oDataObject.SetText ""
oDataObject.PutInClipboard

Set oDataObject = Nothing

End Sub
 

JFVeneau

XLDnaute Nouveau
Bonjour à tous,
Extra ! Bravo, c'est un super programme.
Avec la webcam intégrée à mon ordinateur portable, ça fonctionne du premier coup parfaitement.
Par contre avec une webcam complémentaire branchée sur le port usb, l'image n’apparaît pas dans le useform.
Je vais relire les différents échanges, ce point est peut-être déjà mentionné.
Merci encore pour le super job.
 

Discussions similaires

Statistiques des forums

Discussions
284 862
Messages
1 863 695
Membres
155 617
dernier inscrit
MoriSI
Haut Bas