Prévisualisation lors du pilotage de la caméra à partir d'excel

**frankytactik** · 08/02/2013, 16h15

Bonjour,Je dois piloter la camera extérieure de ma tablette Dell latitude ST sous windows 7 et office 2010.
Le driver installé est integrated webcam 6.1.7601.17514
J'ai besoin de voir en permanance la prévisualisation à l'écran et lorsque j'appuie sur un bouton je dois recopier l'image capturée dans l'onglet 'work' d'un fichier excel.
Je parvient prévisualiser et à copier l'image une fois. A la deuxième manipulation, je perds le contact du driver et il m'apparaît une fenêtre verte au lieu de l'image derrière la caméra.
J'ai essayé de créer un deuxième bouton n'exécutant que le code suivant:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
 SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480

au lieu de:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
hWnd = capCreateCaptureWindowA("enwèye dont", WS_VISIBLE, 0, 0, 200, 200, GetDesktopWindow(), 0)
 SendMessage hWnd, WM_CAP_DRIVER_CONNECT, 0, 0
 SendMessage hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0
 SendMessage hWnd, WM_CAP_SET_SCALE, 1, 0
 SendMessage hWnd, WM_CAP_SET_PREVIEW, 1, 0
 SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
 SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480

pour ne pas avoir à recréer une fenêtre de prévisualisation chaque fois. Chaque fois que j'Appuie sur le bonton la prévisualisation continue de rouler mais l'image collée est toujours la première que j'ai copié.
Précision: j'effectue mes tests avec l'application de webcam Dell ouvert en mode IM pour pouvoir me déconnecter et me reconnecter au driver.
voici mon code:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
Option Explicit
 
Const WM_CAP As Long = &H400
 Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP + 10
 Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP + 11
 Const WM_CAP_SAVEDIB = WM_CAP + 25
 Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
 Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
 Const WM_CAP_DLG_VIDEOFORMAT = WM_CAP + 41
 Const WM_CAP_DLG_VIDEOSOURCE = WM_CAP + 42
 Const WM_CAP_DLG_VIDEODISPLAY = WM_CAP + 43
 Const WM_CAP_GET_VIDEOFORMAT = WM_CAP + 44
 Const WM_CAP_SET_VIDEOFORMAT = WM_CAP + 45
 Const WM_CAP_DLG_VIDEOCOMPRESSION = WM_CAP + 46
 Const WM_CAP_SET_PREVIEWRATE = WM_CAP + 52
 Const WM_CAP_SET_SCALE = WM_CAP + 53
 Const WM_CAP_GRAB_FRAME = WM_CAP + 60
 Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP + 61
 Const WM_CAP_STOP = WM_CAP + 68
 Const WM_CLOSE = &H10
 Const WM_DESTROY = &H2
 Const WM_NCDESTROY = &H82
 Const WM_QUIT = &H12
 
Const WS_CHILD As Long = &H40000000
 Const WS_VISIBLE As Long = &H10000000
 Const WS_POPUP As Long = &H80000000
 Const HWND_BOTTOM As Long = 1
 Const SWP_NOMOVE As Long = &H2
 Public hWnd As Long
 Declare Function TerminateProcess Lib "kernel32" (ByVal hProcess As Long, ByVal uExitCode As Long) As Long
 Declare Function DestroyWindow Lib "user32" (ByVal hndw As Long) As Boolean
 Declare Function GetDesktopWindow Lib "user32" () As Long
 Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
 (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
 Private Declare Function FindWindowEx Lib "user32" Alias "FindWindowExA" _
 (ByVal hWnd1 As Long, ByVal hWnd2 As Long, ByVal lpsz1 As String, ByVal lpsz2 As String) As Long
 
 Declare Function capCreateCaptureWindowA Lib "avicap32.dll" _
 (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, _
 ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long
 Declare Function capGetDriverDescriptionA Lib "avicap32.dll" _
 (ByVal wDriver As Long, ByVal lpszName As String, _
 ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boolean
 
 
Sub WebCamClip()
 
hWnd = 0
 
 If hWnd = 0 Then
 hWnd = capCreateCaptureWindowA("enwèye dont", WS_VISIBLE, 0, 0, 200, 200, GetDesktopWindow(), 0)
 SendMessage hWnd, WM_CAP_DRIVER_CONNECT, 0, 0
 SendMessage hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0
 SendMessage hWnd, WM_CAP_SET_SCALE, 1, 0
 SendMessage hWnd, WM_CAP_SET_PREVIEW, 1, 0
 SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
 SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480
 
 End If
 
 End Sub
 
Public Sub concentrateur(qual2 As String, row As Integer)
 
 'effectue la capture d'image
 Module1.WebCamClip
 
 Sheets("Work").Activate
 If Sheets("work").ChartObjects.Count = 0 Then
 With Sheets("work").ChartObjects.Add(0, 0, 480, 320).Chart
 .Paste
 End With
 Sheets("work").ChartObjects(1).Select
 Else
 Sheets("work").ChartObjects(1).Select
 With Sheets("work").ChartObjects(1).Chart
 .Paste
 End With
 End If
 End Sub

merci

**mercatog** · 08/02/2013, 18h38

J'ai adapté et testé ton code
J'ai ajouté sur la feuille Work 2 boutons, l'un pour capturer l'image et l'autre pour déconnecter et fermer la caméra

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Const WM_CAP As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP + 11
Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
Const WM_CAP_SET_PREVIEWRATE = WM_CAP + 52
Const WM_CAP_SET_SCALE = WM_CAP + 53
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP + 61
Const WM_CLOSE = &H10
Const WM_QUIT = &H12
Const WS_VISIBLE As Long = &H10000000
Dim hWnd As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long
Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Long, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boolean
 
 
Sub WebCamClip()
 
If hWnd = 0 Then
    hWnd = capCreateCaptureWindowA("BlaBla dont", WS_VISIBLE, 0, 0, 200, 200, GetDesktopWindow(), 0)
    SendMessage hWnd, WM_CAP_DRIVER_CONNECT, 0, 0
    SendMessage hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0
    SendMessage hWnd, WM_CAP_SET_SCALE, 1, 0
    SendMessage hWnd, WM_CAP_SET_PREVIEW, 1, 0
    SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End If
SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480
End Sub
 
Sub Capturer()
 
'effectue la capture d'image
WebCamClip
With Worksheets("Work")
    If .ChartObjects.Count = 0 Then
        .ChartObjects.Add(0, 0, 480, 320).Chart.Paste
    Else
        .ChartObjects(1).Chart.Paste
    End If
End With
End Sub
 
'Obligatoire pour fermer la cam
Sub Fermer()
 
If hWnd <> 0 Then
    SendMessage hWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
    SendMessage hWnd, WM_CLOSE, 0, 0
    SendMessage hWnd, WM_QUIT, 0, 0
    hWnd = 0
End If
End Sub

**frankytactik** · 08/02/2013, 19h32

Envoyé par mercatog

J'ai adapté et testé ton code
J'ai ajouté sur la feuille Work 2 boutons, l'un pour capturer l'image et l'autre pour déconnecter et fermer la caméra

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
Option Explicit
 
Const WM_CAP As Long = &H400
Const WM_CAP_DRIVER_CONNECT As Long = WM_CAP + 10
Const WM_CAP_DRIVER_DISCONNECT As Long = WM_CAP + 11
Const WM_CAP_EDIT_COPY As Long = WM_CAP + 30
Const WM_CAP_SET_PREVIEW As Long = WM_CAP + 50
Const WM_CAP_SET_PREVIEWRATE = WM_CAP + 52
Const WM_CAP_SET_SCALE = WM_CAP + 53
Const WM_CAP_GRAB_FRAME_NOSTOP = WM_CAP + 61
Const WM_CLOSE = &H10
Const WM_QUIT = &H12
Const WS_VISIBLE As Long = &H10000000
Dim hWnd As Long
Declare Function GetDesktopWindow Lib "user32" () As Long
Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long
Declare Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal hWndParent As Long, ByVal nID As Long) As Long
Declare Function capGetDriverDescriptionA Lib "avicap32.dll" (ByVal wDriver As Long, ByVal lpszName As String, ByVal cbName As Long, ByVal lpszVer As String, ByVal cbVer As Long) As Boolean
 
 
Sub WebCamClip()
 
If hWnd = 0 Then
    hWnd = capCreateCaptureWindowA("BlaBla dont", WS_VISIBLE, 0, 0, 200, 200, GetDesktopWindow(), 0)
    SendMessage hWnd, WM_CAP_DRIVER_CONNECT, 0, 0
    SendMessage hWnd, WM_CAP_SET_PREVIEWRATE, 30, 0
    SendMessage hWnd, WM_CAP_SET_SCALE, 1, 0
    SendMessage hWnd, WM_CAP_SET_PREVIEW, 1, 0
    SendMessage hWnd, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0
End If
SendMessage hWnd, WM_CAP_EDIT_COPY, 640, 480
End Sub
 
Sub Capturer()
 
'effectue la capture d'image
WebCamClip
With Worksheets("Work")
    If .ChartObjects.Count = 0 Then
        .ChartObjects.Add(0, 0, 480, 320).Chart.Paste
    Else
        .ChartObjects(1).Chart.Paste
    End If
End With
End Sub
 
'Obligatoire pour fermer la cam
Sub Fermer()
 
If hWnd <> 0 Then
    SendMessage hWnd, WM_CAP_DRIVER_DISCONNECT, 0, 0
    SendMessage hWnd, WM_CLOSE, 0, 0
    SendMessage hWnd, WM_QUIT, 0, 0
    hWnd = 0
End If
End Sub

**djenna** · 04/07/2018, 10h23

Bonjour auriez vous encore votre fichier excel ? merci

Prévisualisation lors du pilotage de la caméra à partir d'excel

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager