Insertar imagen en hoja
¿Hola experto, que tal?! ... Tengo un problema y ojala me puedas dar una solución, tengo un formulario en en cual se ingresan los datos de los empleados pero ahora se tiene que ingresar junto con los datos la foto del empleado, para ello ya logre que en el formulario se busque la foto y se muestre en el formulario pero cuando quiero que se inserte en la hoja (como los demás datos que ingreso) este no se inserta y he investigado pero no encuentro solución es por ello que tengo que consultarle a un experto :) ; ojala me deje explicar, ya la imagen la puedo seleccionar y se muestra en el formulario ... Los datos se comienzan a insertar a partir de la celda A3 y luego sigue a B3, D3, E3 y así sucesivamente hasta que llega a la celda K3 y aquí es donde se debe insertar la imagen pero no lo logro ... Claro después si deseo nuevamente ingresar datos ahora va a la fila A4 y sigue el mismo procedimiento, como te darás cuenta en el código que sigue :
Private Sub BOTON_ACTUALIZAR_REGIS_Click()
ThisWorkbook.Activate
Sheets("EMPLEADOS").Activate
Range("A3").Activate
Do While ActiveCell.Value > ""
If ActiveCell.Value = ID.Text Then
ActiveCell.Offset(0, 1).Value = NOMBRE.Value
ActiveCell.Offset(0, 2).Value = APEYIDOS.Value
ActiveCell.Offset(0, 3).Value = FEC_NAC.Value
ActiveCell.Offset(0, 4).Value = DIREC.Text
ActiveCell.Offset(0, 5).Value = TEL_MOVIL.Value
ActiveCell.Offset(0, 6).Value = TEL_FIJO.Value
ActiveCell.Offset(0, 7).Value = EMAIL.Value
ActiveCell.Offset(0, 8).Value = COMPANY.Value
ActiveCell.Offset(0, 9).Value = PEAJE_COMBOBOX.Value
'ActiveCell.Offset(0, 10).Value = Image_EMPLEADO.Picture
Exit Do
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Sub BOTON_CONSULTA_Click()
Hoja1.Activate
Hoja1.Range("A3").Select
Dim rng As Range
Set rng = Range("A3:A50").Find(What:=ID, After:=Range("A3"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If rng Is Nothing Then
MsgBox "Dato no encontrado": Range("A3").Select: ID = "": ID.SetFocus
Else
rng.Select
End If
ActiveCell.Offset(0, 1).Select
NOMBRE = ActiveCell
ActiveCell.Offset(0, 1).Select
APEYIDOS = ActiveCell
ActiveCell.Offset(0, 1).Select
FEC_NAC = ActiveCell
ActiveCell.Offset(0, 1).Select
DIREC = ActiveCell
ActiveCell.Offset(0, 1).Select
TEL_MOVIL = ActiveCell
ActiveCell.Offset(0, 1).Select
TEL_FIJO = ActiveCell
ActiveCell.Offset(0, 1).Select
EMAIL = ActiveCell
ActiveCell.Offset(0, 1).Select
COMPANY = ActiveCell
ActiveCell.Offset(0, 1).Select
PEAJE_COMBOBOX = ActiveCell
End Sub
Private Sub BOTON_ELIMINAR_USU_Click()
Selection.EntireRow.Delete
Range("A2").Select
ID = Empty
NOMBRE = Empty
APEYIDOS = Empty
FEC_NAC = Empty
DIREC = Empty
TEL_MOVIL = Empty
TEL_FIJO = Empty
EMAIL = Empty
PEAJE_COMBOBOX = Empty
'Image_EMPLEADO.Picture = Empty LoadPicture("")
ID.SetFocus
End Sub
Private Sub BOTON_NUEVO_EMPLEADO_CLICK()
Dim CeldaInicial As Variant
Dim col As Integer
Dim fila As Integer
CeldaInicial = "A2"
Set CeldaInicial = Range(CeldaInicial)
col = CeldaInicial.Column
'Busca cuál es la última fila
If CeldaInicial.Offset(1, 0).Value = "" Then
fila = 3
Else
fila = CeldaInicial.End(xlDown).Row + 1
End If
'Comienza a copiar los valores del UserForm a la hoja
Cells(fila, col).Value = ID.Value
Cells(fila, col + 1).Value = NOMBRE.Value
Cells(fila, col + 2).Value = APEYIDOS.Value
Cells(fila, col + 3).Value = FEC_NAC.Value
Cells(fila, col + 4).Value = DIREC.Value
Cells(fila, col + 5).Value = TEL_MOVIL.Value
Cells(fila, col + 6).Value = TEL_FIJO.Value
Cells(fila, col + 7).Value = EMAIL.Value
Cells(fila, col + 8).Value = COMPANY.Value
Cells(fila, col + 9).Value = PEAJE_COMBOBOX.Value
'Cells(fila, col + 10).DrawingObjects.Insert = Image_EMPLEADO.Picture
ActiveSheet.Cells(fila, col + 10).Select
ActiveSheet.Pictures.Insert(IWOLLS).Select
Set CeldaInicial = Nothing
ID = ""
NOMBRE = ""
APEYIDOS = ""
FEC_NAC = ""
DIREC = ""
TEL_MOVIL = ""
TEL_FIJO = ""
EMAIL = ""
COMPANY = "VEGAMOUT"
PEAJE_COMBOBOX = ""
Image_EMPLEADO.Picture = Nothing
ID.SetFocus
End Sub
Private Sub BOTON_SALIR_Click()
Unload Me
End Sub
Private Sub BOTON_FOTO_Click()
IWOLLS = Application.GetOpenFilename ' Elegimos la imagen y la ruta
FORMULARIO_EMPLEADO.Image_EMPLEADO.Picture = LoadPicture(IWOLLS) ' cargamos la imagen en el formulario
'ActiveSheet.Pictures.Insert(IWOLLS).Select 'Cargamos la imagen en la hoja
End Sub
Private Sub LIMPIAR_CONSULTA_Click()
'limpiamos los datos
ID = ""
NOMBRE = ""
APEYIDOS = ""
FEC_NAC = ""
DIREC = ""
TEL_MOVIL = ""
TEL_FIJO = ""
EMAIL = ""
PEAJE_COMBOBOX = ""
'Image_EMPLEADO.DrawingObjects.Delete '.DrawingObjects.Delete
'ponemos el focus en el TextBox1
ID.SetFocus
End Sub
La parte donde esta el botón nuevo empleado y demás botones ahí es donde tengo los problemas, ojala puedas revisarlo y tratar de llegar a una solución ... De ante mano muchas gracias ...
Private Sub BOTON_ACTUALIZAR_REGIS_Click()
ThisWorkbook.Activate
Sheets("EMPLEADOS").Activate
Range("A3").Activate
Do While ActiveCell.Value > ""
If ActiveCell.Value = ID.Text Then
ActiveCell.Offset(0, 1).Value = NOMBRE.Value
ActiveCell.Offset(0, 2).Value = APEYIDOS.Value
ActiveCell.Offset(0, 3).Value = FEC_NAC.Value
ActiveCell.Offset(0, 4).Value = DIREC.Text
ActiveCell.Offset(0, 5).Value = TEL_MOVIL.Value
ActiveCell.Offset(0, 6).Value = TEL_FIJO.Value
ActiveCell.Offset(0, 7).Value = EMAIL.Value
ActiveCell.Offset(0, 8).Value = COMPANY.Value
ActiveCell.Offset(0, 9).Value = PEAJE_COMBOBOX.Value
'ActiveCell.Offset(0, 10).Value = Image_EMPLEADO.Picture
Exit Do
End If
ActiveCell.Offset(1, 0).Activate
Loop
End Sub
Private Sub BOTON_CONSULTA_Click()
Hoja1.Activate
Hoja1.Range("A3").Select
Dim rng As Range
Set rng = Range("A3:A50").Find(What:=ID, After:=Range("A3"), LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False)
If rng Is Nothing Then
MsgBox "Dato no encontrado": Range("A3").Select: ID = "": ID.SetFocus
Else
rng.Select
End If
ActiveCell.Offset(0, 1).Select
NOMBRE = ActiveCell
ActiveCell.Offset(0, 1).Select
APEYIDOS = ActiveCell
ActiveCell.Offset(0, 1).Select
FEC_NAC = ActiveCell
ActiveCell.Offset(0, 1).Select
DIREC = ActiveCell
ActiveCell.Offset(0, 1).Select
TEL_MOVIL = ActiveCell
ActiveCell.Offset(0, 1).Select
TEL_FIJO = ActiveCell
ActiveCell.Offset(0, 1).Select
EMAIL = ActiveCell
ActiveCell.Offset(0, 1).Select
COMPANY = ActiveCell
ActiveCell.Offset(0, 1).Select
PEAJE_COMBOBOX = ActiveCell
End Sub
Private Sub BOTON_ELIMINAR_USU_Click()
Selection.EntireRow.Delete
Range("A2").Select
ID = Empty
NOMBRE = Empty
APEYIDOS = Empty
FEC_NAC = Empty
DIREC = Empty
TEL_MOVIL = Empty
TEL_FIJO = Empty
EMAIL = Empty
PEAJE_COMBOBOX = Empty
'Image_EMPLEADO.Picture = Empty LoadPicture("")
ID.SetFocus
End Sub
Private Sub BOTON_NUEVO_EMPLEADO_CLICK()
Dim CeldaInicial As Variant
Dim col As Integer
Dim fila As Integer
CeldaInicial = "A2"
Set CeldaInicial = Range(CeldaInicial)
col = CeldaInicial.Column
'Busca cuál es la última fila
If CeldaInicial.Offset(1, 0).Value = "" Then
fila = 3
Else
fila = CeldaInicial.End(xlDown).Row + 1
End If
'Comienza a copiar los valores del UserForm a la hoja
Cells(fila, col).Value = ID.Value
Cells(fila, col + 1).Value = NOMBRE.Value
Cells(fila, col + 2).Value = APEYIDOS.Value
Cells(fila, col + 3).Value = FEC_NAC.Value
Cells(fila, col + 4).Value = DIREC.Value
Cells(fila, col + 5).Value = TEL_MOVIL.Value
Cells(fila, col + 6).Value = TEL_FIJO.Value
Cells(fila, col + 7).Value = EMAIL.Value
Cells(fila, col + 8).Value = COMPANY.Value
Cells(fila, col + 9).Value = PEAJE_COMBOBOX.Value
'Cells(fila, col + 10).DrawingObjects.Insert = Image_EMPLEADO.Picture
ActiveSheet.Cells(fila, col + 10).Select
ActiveSheet.Pictures.Insert(IWOLLS).Select
Set CeldaInicial = Nothing
ID = ""
NOMBRE = ""
APEYIDOS = ""
FEC_NAC = ""
DIREC = ""
TEL_MOVIL = ""
TEL_FIJO = ""
EMAIL = ""
COMPANY = "VEGAMOUT"
PEAJE_COMBOBOX = ""
Image_EMPLEADO.Picture = Nothing
ID.SetFocus
End Sub
Private Sub BOTON_SALIR_Click()
Unload Me
End Sub
Private Sub BOTON_FOTO_Click()
IWOLLS = Application.GetOpenFilename ' Elegimos la imagen y la ruta
FORMULARIO_EMPLEADO.Image_EMPLEADO.Picture = LoadPicture(IWOLLS) ' cargamos la imagen en el formulario
'ActiveSheet.Pictures.Insert(IWOLLS).Select 'Cargamos la imagen en la hoja
End Sub
Private Sub LIMPIAR_CONSULTA_Click()
'limpiamos los datos
ID = ""
NOMBRE = ""
APEYIDOS = ""
FEC_NAC = ""
DIREC = ""
TEL_MOVIL = ""
TEL_FIJO = ""
EMAIL = ""
PEAJE_COMBOBOX = ""
'Image_EMPLEADO.DrawingObjects.Delete '.DrawingObjects.Delete
'ponemos el focus en el TextBox1
ID.SetFocus
End Sub
La parte donde esta el botón nuevo empleado y demás botones ahí es donde tengo los problemas, ojala puedas revisarlo y tratar de llegar a una solución ... De ante mano muchas gracias ...
Respuesta de boumerang
1