Discussion :

[Juju67]

Bonjour à tout le monde!


Je suis à la recherche d'un petit programme capable de prendre des photos depuis ma webcam et importer ces photos sur ma feuille EXCEL. En parcourant plusieurs forums, j'ai trouvé des choses intéressantes mais rien ne fonctionne avec EXCEL 64 bits!!



Est ce quelqu'un se sent d'attaque pour me donner un petit coup de main (?)

PS : J'ai un PC/tablette LENOVO MIIX 520.

MERCI d'avance!

[eriiic]

Bonjour,

VBA 64 bits ne peut pas utiliser les ActiveX qui sont tous en 32 bits.
Si tu as installé cette version en pensant bien faire, désinstalle-la pour mettre la 32 bits.
On ne met la 64 bits que quand on est obligé.
eric

[Juju67]

Bonjour Eric,

Merci pour ta réponse.

Cependant, je te confirme que je suis bien obligé de prendre cette version (imposé par mon école )
Il n'y a donc aucun moyen de réaliser ma demande sur une version 64 bits d'Excel ?

[eriiic]

Ils t'ont peut-être imposé 2016 ou autre.
Mais imposer la 64 vs 32 c'est limiter beaucoup les possibilités en vba, ça parait étrange.

Pour en importer une tu peux essayer avec ça :

Code :

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

1
2
3
4
5
6
7
8
    Dim img As String, image As Picture
    On Error Resume Next
    Shapes("MonImage").Delete
    On Error GoTo 0
    img = "C:\tmp\ton_image.jpg"
    [B2].Select
    Set image = ActiveSheet.Pictures.Insert(nf)
    image.Name = "MonImage"

eric

[Juju67]

C'est une version Excel 2013 en 64 bits qui nous est imposée.

Merci pour le code. Effectivement, cette solution pourrait me servir de plan B.
Mais dans un premier temps je recherche plutôt un code capable de d'afficher une fenêtre avec la webcam / prendre la photo / importer la photo sur la feuille et tout çà depuis Excel.

J'espère que la requête n'est pas impossible...

Merci pour ton aide!
JuJu67

[eriiic]

C'est beau l'optimisme
N'oublie de venir poster le résultat ici si tu trouves.

[patricktoulon]

re

cadeau
edit je suis pas sur d'avoir adapter correctement les api pour 64 a voir

re edit:
pour le coup je les ai refait en 64 bit correctement je crois
changer la declaration d'api globalement par celle ci

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
#If win64 Then
    #If vba7 Then
        '''''Private  ptrsafe 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
 
        Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As LongPtr)
        Private Declare PtrSafe Function capCreateCaptureWindowA Lib "avicap32.dll" (ByVal lpszWindowName As String, ByVal dwStyle As LongPtr , ByVal x As LongPtr, ByVal Y As LongPtr, ByVal nWidth As LongPtr , ByVal nHeight As LongPtr, ByVal hwnd As LongPtr, ByVal hwndParent As LongPtr, ByVal nID As LongPtr) As LongPtr
        Private Declare PtrSafe Function SendMessageA Lib "user32" (ByVal hWnd As LongPtr, ByVal wMsg As Long,ByVal wParam As LongPtr, lParam As Any) As LongPtr
        Private Declare PtrSafe Function SWLG Lib "USER32" Alias "SetWindowLongPtrA" (ByVal hWnd As LongPtr, ByVal nIndex As Long, ByVal dwNewLong As LongPtr) As LongPtr
        Private Declare PtrSafe Function SWPOS Lib "user32" Alias "SetWindowPos "(ByVal hwnd As LongPtr, ByVal hWndInsertAfter As LongPtr,ByVal X As Long, ByVal Y As Long, ByVal cx As Long,ByVal cy As Long, ByVal wFlags As Long) As Long
        Private Declare PtrSafe Function GetDesktopWindow Lib "USER32" () As LongPtr
        Private Declare PtrSafe Function DrawMenuBar Lib "user32" (ByVal hWnd As LongPtr) As Long
        Private Declare PtrSafe Function FindWindow Lib "USER32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As LongPtr
    #Else
        Private Declare Function GetDesktopWindow Lib "user32" () As Long
        Private 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 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
        'Private 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
        Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
        Private Declare Function SetParent Lib "User32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
        Private Declare Function SWLG Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
        Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
        Private Declare Function SWPOS Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
        Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
    #End If
#Else
    Private Declare Function GetDesktopWindow Lib "user32" () As Long
    Private 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 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
    '''''Private 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
    Private Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
    Private Declare Function SetParent Lib "User32.dll" (ByVal hWndChild As Long, ByVal hWndNewParent As Long) As Long
    Private Declare Function SWLG Lib "user32" Alias "SetWindowLongA" (ByVal hwnd As Long, ByVal nIndex As Long, ByVal dwNewLong As Long) As Long
    Private Declare Function DrawMenuBar Lib "user32" (ByVal hwnd As Long) As Long
    Private Declare Function SWPOS Lib "user32" Alias "SetWindowPos" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal x As Long, ByVal y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long
    Private Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
 
#End If

[Juju67]

Bonjour Patrick!

Tout d'abord, merci d'avoir répondu et d'avoir partager ce super code!
Quand je lance la macro avec Excel, j'ai une erreur au niveau de la ligne 5 (Excel m'identifie particulièrement "capCreateCaptureWindowA") ci-dessous :

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
Sub WebCamClip()
    PtoPX = CreateObject("WScript.Shell").RegRead("HKEY_CURRENT_USER\Control Panel\Desktop\WindowMetrics\AppliedDPI") / 72
    Me.Height = ((Me.Width / 4) * 3) + (70 / PtoPX)
    If Hcamera = 0 Then
        Hcamera = capCreateCaptureWindowA("Live_Preview", WS_VISIBLE, 0, 0, 400, 300, handle_Form, 0)    'creation de la fentre de preview
        handle_Form = FindWindow(vbNullString, Me.Caption)    'capture du handle de l'userform
        If Hcamera <> 0 Then    'si il est capté
            SWLG Hcamera, -16, &H94080080: SWLG Hcamera, -20, &H0:    ' on enleve la caption de la fenetre hcamera
            DrawMenuBar Hcamera    ' on redessine le decalage due a la suppression de la caption
            SetParent Hcamera, handle_Form    'on ' affilie le preview a son nouveau parent (le userform)
            SWPOS Hcamera, 0, 6, 60, (Me.Width * PtoPX) - 20, (((Me.Width * PtoPX) - 40) / 4) * 3, 0    'on positionne le preview correctement dans le userform
            Me.Repaint    'on repaint pour le laps de temps ou il est tout blanc pendant la charge du preview
        End If
        SendMessage Hcamera, WM_CAP_DRIVER_CONNECT, 0, 0    'on se connecte a la camera
        SendMessage Hcamera, WM_CAP_SET_PREVIEWRATE, 90, 0    ' on regle le rate (image par secondes)
        SendMessage Hcamera, WM_CAP_SET_SCALE, 1, 0    ' on scale le ratio ou pas
        SendMessage Hcamera, WM_CAP_SET_PREVIEW, 1, 0    ' on met le preview a true
        SendMessage Hcamera, WM_CAP_GRAB_FRAME_NOSTOP, 0, 0    '  on roule le preview (non stop)
    End If
End Sub

As-tu une idée du problème ? Penses-tu que cela pourrais venir du code ? Ou peut-être du driver de ma webcam?

A bientôt
JuJu67

[parmi]

Salut Patrick,

Je viens de voir ton programme et ça fonctionne super bien sur mon PC avec une caméra externe Blue Eyeball
Par contre, sur une tablette équipée de 2 caméras internes (USB 2M WebCam et OV8858), le programme trouve les noms, mais ça ne fonctionne pas - image noire.

Aurais-tu une idée pour régler ce problème ?
Je dois absolument utiliser la caméra arrière...

La tablette est sous Windows 10 64 bits et Office 64 bits.

[patricktoulon]

Bonjour Parmi
ne connaissant pas l'architecture de W10 tablet je peux pas te donner d'indication je suis même pas sur que les dll requises sont présentes dans des librairies dans cet os

j'ai un autre procédé si tu veux que j'avais pécher je ne sais plus ou

[parmi]

D'après les IT, c'est la même image de Windows que sur les PC du bureau.
Donc toutes les librairies devraient y être.

Par contre, si tu as une autre idée, je suis preneur.
J'ai trouvé certains codes sur le web, mais rien de concluant jusqu'à maintenant.

[parmi]

Et je viens d'essayer sur un portable du bureau et ça ne fonctionne pas.
Je vois la lumière de la caméra s'allumer, mais l'image est noire (?!)

Peut-être un setting dans Windows à modifier ?

[patricktoulon]

re
Attention quand c'est des drivers Génériques Microsoft et non les drivers du constructeurs de la cam ,ca ne fonctionne pas je l'ai remarqué plusieurs fois
sur mon ancien pc portable ca fonctionne je viens de tester

[parmi]

Merci, je vais faire une recherche dans ce sens.
Dans les propriétés ça indique Integrated Camera, pas de marque ou modèle...

[patricktoulon]

re
dans la fenêtre qui s'ouvre au départ pour choisir ta cam tu a quoi?
normalement tu devrai avoir le nom de ta cam si tu l'a pas c'est que tu n'a pas les drivers signés

[parmi]

Sur le portable, c'est inscrit Périphérique vidéo USB
Je ne vois pas la raison du USB vu que la caméra est interne (?)

[parmi]

Sur la tablette, il y a les deux:
USB 2M WebCam
OV8858

Si je sélectionne la 1ere, la lumière s'allume devant.
Celle derrière est la OV8858

[patricktoulon]

re
c'est ca tu a les drivers génériques de Microsoft

télécharge aida32 et liste tes périphériques tu aura les vrais noms ou noms complets et peut être même le lien constructeur
voir aussi si directX present et/ou compatible

[parmi]

Sur le portable, je vois Integrated camera dans la section Périphériques / Périphériques physiques / Périphériques USB

Sur la tablette, dans la même section, je trouve USB 2M WebCam
Dans Périphériques PnP, il y a Camera sensor OV13858
Je retrouve les mêmes dans la section Périphériques Windows.

[clementmarcotte]

Bonjour.

J'ai donné "USB 2m webcam" en pâture à Bing. Sur la page de résultats que j'ai obtenus. il y a des liens vers des téléchargements pour Asus et un lien qui parle d'un problème avec Windows 10 qui est corrigé.

https://www.bing.com/search?q=USB+2M...ffaa2ad8442e8f

Le même "exercice" pour Camera sensor ov13858 donne un lien pour des pilotes de chez Intel

https://www.bing.com/search?q=Camera...ea157b9080d834