Holla me enviarias la planilha de webcam?

[email protected]

Me gustaria de tomar nota y testar una webcam con el excell,

1 respuesta

Respuesta
1

H o l a:

¿La macro a la que te refieres para tomar fotos es la que se utiliza con un Userform?

Esta es la macro que se utiliza en un userform:

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

El userform y la hoja se ven así:


Avísame si es lo que necesitas para enviarte el archivo por correo.


Añade tu respuesta

Haz clic para o

Más respuestas relacionadas