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