Mesmo antes que encham a minha caixa de e-mails perguntando: Mas qual a utilização de um código como esse? Já lhes adianto, especialmente para você que está chegando agora, O objetivo desse Blog é que você conheça todas as possibilidade e limites do VBA.
Agora para os mais céticos, informo-lhes que alguns tem usado este código para acompanhar o que acontece em suas casas, pois instalam-no em seus notebooks e os deixa aberto em locais de grande movimentação. Desse modo tudo é registrado para análise posterior.
UTILIDADE: Essa funcionalidade pode ser aplicada em softwares de cadastro de portaria, identificação de acesso, ou mesmo registrar a imagem dos seus colegas de trabalho para formar uma albúm.
Para utilizar esse código é necessário que faça referência a Windows Image Acquisition library.
1ª VERSÃO
Sub btnCaptPhoto01_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
Let tempfile = ("C:\Bernardess\filename.jpg") 'put the path and name for the location of your temp file here.
'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
Set Commondialog1 = New CommonDialog
Set imfile = Commondialog1.ShowAcquireImage
If imfile Is Nothing Then
MsgBox "Action aborted"
Else
imfile.SaveFile (tempfile) 'this line saves the picture to a specified file
Let Me.Image1.Picture = (tempfile) 'this sets the picture on the form to show the new picture
End If
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
2ª VERSÃO
Sub btnCaptPhoto02_Click()
On Error GoTo Err_btnCapturePhoto_click
Dim tempfile As String
Dim mydevice As WIA.device
Dim WIA_Device As Object
Dim item As WIA.item
Dim imfile As WIA.ImageFile
Dim Commondialog1 As WIA.CommonDialog
If IsNull(Me.SANumber) Then
MsgBox "You must select a client before taking the picture."
Exit Sub
End If
'put the path and name for the location of your picture file here.
'SANum is the employee/client number
Let tempfile = ("C:\Bernardess\Pics\" & Me.cboSANum & ".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
Let Me.VideoPreview1.Enabled = False
Set Commondialog1 = New CommonDialog
Set mydevice = Commondialog1.ShowSelectDevice
Set item = mydevice.ExecuteCommand(wiaCommandTakePicture)
Set imfile = item.Transfer
If imfile Is Nothing Then
MsgBox "Action aborted"
Else
imfile.SaveFile (tempfile) 'this line saves the picture to a specified file
DoCmd.RunCommand acCmdSaveRecord
Let Me.imgPhoto.Picture = (tempfile) 'this sets the picture on the form to show the new picture
Let Me.txtImageName = Me.cboSANum & ".jpg"
End If
Exit_btnCapturePhoto_click:
Let Me.VideoPreview1.Enabled = True
Set mydevice = Nothing
Set item = Nothing
Set imfile = Nothing
Exit Sub
Err_btnCapturePhoto_click:
MsgBox Err.Description, vbOKOnly + vbCritical, "Error Taking Picture"
Resume Exit_btnCapturePhoto_click
End Sub
Tags: VBA, Câmera, capture, image,Windows Image Acquisition library, Acquisition, picture, pics
Nenhum comentário:
Postar um comentário