Tomar foto con webcam y guardarla en la misma ubicación del Libro que contiene el formulario con el nombre del TxtCedula

H o l a:

Estas son las macro para tomar la foto y para guardar

Dim htmp As String
Dim fichero As String
Const fgif = "foto"
Const mipath = "c:\" 'debe acabar en \ el directorio donde guardar las fotos
'
Private Sub CommandButton2_Click()
' Por.Dante Amor
    uf = Range("A" & Rows.Count).End(xlUp).Row + 1
    Range("A" & uf) = TextBox1
    Range("B" & uf) = TextBox2
    Range("C" & uf).Select
    ActiveSheet.Pictures.Insert(fichero).Select
    '
    With Selection
        .Placement = xlFreeFloating
        .PrintObject = True
        .ShapeRange.LockAspectRatio = msoFalse
        .ShapeRange.Height = 115#
        .ShapeRange.Width = 99#
        .ShapeRange.Rotation = 0#
        .ShapeRange.Left = Range("C" & uf).Left
        .ShapeRange.Top = Range("C" & uf).Top
    End With
End Sub
'
Private Sub CommandButton1_Click()
'Actualizado, Por.Dante Amor
    Dim s As Shape
    'Crea la hoja para guardar temporalmente la foto
    Application.ScreenUpdating = False
    Sheets.Add
    htmp = ActiveSheet.Name
    Sheets(htmp).Select
    Sheets(htmp).ChartObjects.Add(0, 0, 200, 250).Name = fgif
    Application.CommandBars.FindControl(ID:=1764).Execute
    'es necesaria una hoja creada al inicio para la captura
    'al grabar se crea una copia en la hoja que es un shape
    Selection.Copy
    Sheets(htmp).ChartObjects(fgif).Activate
    ActiveChart.ChartArea.Select
    ActiveChart.Paste
    'En esta parte se guarda el nombre de la foto, _
    puedes cambiar el texto "num-inscripcion" por un valor
    fichero = mipath & "num-inscripcion" & ".gif"
    ActiveChart.Export Filename:=fichero 'graba en disco la foto
    Me.Image1.Picture = LoadPicture(fichero)
    'limpio la foto pegada y el chart
    For Each s In Sheets(htmp).Shapes
        s.Delete
    Next s
    'Borra hoja temporal
    Application.DisplayAlerts = False
    Worksheets(htmp).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

' : )
'S aludos. Dante Amor. Recuerda valorar la respuesta. G racias
' : )

¡Gracias! Wau... que cantidad de código. Voy a verificarlos ya mismo.

Dante, veo que las imágenes capturadas se guardan dentro del libro y necesito que se guarden es en la misma carpeta donde está el fichero, no en la hoja.

Dante, disculpa el atrevimiento y el abuso, si gustas te puedo enviar el fichero donde está el formulario ya muy funcional gracias a tu valiosa ayuda, para que veas en que ando trabajando y así me puedas ayudar mejor.

Te lo he enviado a tu correo. Mil gracias..!

Te anexo el código

Private Sub Fotografia_Click()
'Por.Dante Amor
    If TxtCedula = "" Then
        MsgBox "Captura la cédula"
        TxtCedula.SetFocus
        Exit Sub
    End If
    Application.ScreenUpdating = True
    Set h2 = Sheets.Add
    h2.Select
    h2.ChartObjects.Add(0, 0, 150, 120).Name = "foto"
    Application.CommandBars.FindControl(ID:=1764).Execute
    Selection.Copy
    h2.ChartObjects("foto").Activate
    ActiveChart.ChartArea.Select
    ActiveChart.Paste
    '
    ruta = ThisWorkbook.Path & "\"
    fichero = ruta & TxtCedula & ".gif"
    ActiveChart.Export Filename:=fichero 'graba en disco la foto
    Fotografia.Picture = LoadPicture(fichero)
    'Borra hoja temporal
    Application.DisplayAlerts = False
    h2.Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

sal u dos

¡Gracias! Voy a realizar las pruebas y te comento en un rato. Mil gracias!

Dante, te cuento que he realizado las pruebas con la web, efectivametne capta un archivo y lo guarda en la carepeta con el nombre del TxtCedula, pero cuando lo busco, es solo un cuadro en blanco.

No hay foto como tal. Lo otro es que cuando doy doble click en el control image, no me aparece la foto en el cuadro.

Será que necesito controladores adicionales para el uso de la cámara ?

Te agradezco la ayuda.

Luis Carlos

La secuencia es la siguiente.

1. Abres tu formulario

2. Presionas doble click en el control image

3. Se debe abrir tu aplicación para tomar fotos

4. Tomas la foto

5. Cierras la aplicación para tomar fotos

6. La foto se guarda en la carpeta

7. La foto se muestra en el control image.

La macro a mi me funciona correctamente. De hecho la macro me funcionaba desde el principio, lo que hice fue adaptar la macro a tu formulario.

¡Gracias! ¿Y tienes un software para tomar las fotos?. ¿Tu cámara está integrada a la pc o también es externa y se conecta con cable usb?

Está integrada a la pc.

Agrega al final de la macro estas 2 líneas:

 DoEvents
    Me. Repaint

Qué pasa si tomas la foto desde la aplicación de la webcam, es decir, sin utilizar la macro.