Camera in Userform

[GeraldDLT]

Hey Genius,

Is there any way that i can open a camera inside the UserForm and take a picture with it?


Thanks,
Gerald

 

[Kmahraz]

NOT TESTED,

On Error GoTo Err_btnTakePicture_click
Dim tempfile As String
Dim mydevice As WIA.Device
Dim item As WIA.item
Dim imfile As WIA.imagefile
Dim Commondialog1 As WIA.CommonDialog
'put the path and name for the location of your temp file here.
tempfile = ("c:\filename.jpg")
'the next 4 lines deletes the old temp file if it exists
Set filesystemobject = CreateObject("Scripting.FileSystemObject")
If filesystemobject.fileExists(tempfile) Then
Kill (tempfile)
End If
'the next two lines set up the configuration
Set Commondialog1 = New CommonDialog
Set mydevice = Commondialog1.ShowSelectDevice
Set item = mydevice.ExecuteCommand(wiaCommandTakePicture) 'instructs the camera to take the picture
Set imfile = item.Transfer 'transfers the picture from the camera
'this line saves the picture to a specified file
imfile.SaveFile (tempfile)
'this sets the picture on the form to show the new picture
OLEUnbound1.Picture = (tempfile)

MsgBox "Picture taken"
Exit_btnTakePicture_click:
Set mydevice = Nothing
Set item = Nothing
Exit Sub
Err_btnTakePicture_click:
MsgBox err.Description, vbOKOnly + vbCritical, "Error Taking Picture"
Resume Exit_btnTakePicture_click
End Sub

Hope this help!

-K-

 

[Kmahraz]

Since I don't have a camera I am unable to test, you can use DropBox to load your files and list the link in your thread.

Please reference the links below for more details on how to use the Camera in VBA, it appear that it only take a picture and paste in a specific location ... or it will be using and controlling another free software to get the job done ....

http://www.mrexcel.com/forum/excel-...-image-using-visual-basic-applications-3.html

http://excelribbon.tips.net/T010521_Using_the_Camera_in_VBA.html

Hope this help!

-K-

 

[GeraldDLT]

Thanks for all the info Kmahraz! however mt PC doesn't support WIA.Device, but then i manage to search some useful tips from the links you gave me.

Private Sub SnapshotButton_Click()
On Error GoTo DirectPicture:
    Dim RetVal
     
    ' Make sure the current directory is set to the one
    ' where the Excel file is saved
    ChDir (ActiveWorkbook.Path)
     
    ' First, delete image file if present
    Kill ("image.bmp")
     
    ' Now, wait until image file is definitely gone
    While Dir("image.bmp") > ""
    Wend
     
    ' Capture new image
DirectPicture:
runcmdcam
     
    ' Wait until image file is definitely there
    While Dir("image.bmp") = ""
    Wend
     
    ' Short delay to let new file finish saving
    Application.Wait (Now + TimeValue("00:00:01"))
     
    ' Load new image into image object on spreadsheet
    Image1.Picture = LoadPicture("image.bmp")
End Sub

 

[Dung Nguyen Xuan]

It seems interesting. Let's me try on!