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 ...

1 Respuesta

Respuesta
1
Si lo que pretendes es pegar una imagen dentro de una celda, hasta donde yo tengo experiencia, no se puede. En todo caso, lo que puedes hacer es pegar una referencia de FileSystem de su ubicación.
-
Primero gracias por responder ... mmm lo que quería hacer es al igual que uno pasa un dato que se ingresa desde el formulario y se almacena en una celda, igual quería hacer con la imagen ... porque como te ahabras dado cuenta en el código con el botón foto yo busco la imagen no es que pongo una ruta, la imagen la busco explorando y al encontrarla me la muestra en el formulario la capturo en el formulario, buscando encontré una macro que al capturar la imagen en el formulario la inserta en la hoja y supuestamente la inserta en un rango pero en la practica no pasa eso intente modificarla pero no pude o no se puede ; no se si puedo mandarte el archivo de esta macro que te comento y tal vez viéndola te puedas dar una idea pero no se si se puede adjuntar archivos cuando te respondo tal vez te la podría mandar a tu correo, porque tal vez si se pueda poner la foto en un rango y si ese rango esta lleno pase al siguiente rango... es cosa que un experto lo vea, y tal vez así se pueda concluir definitivamente si se puede o no ... bueno es una sugerencia, pero de todos modos muchas gracias por el interés como lo exprese lineas arriba, estaré atento a tu respuesta . Saludos.
De acuerdo. Espero el libro con la macro en [email protected]. Referencíala en el asunto como TODOEXERTOS para que no la pase por alto.
-
Finalmente.
Es imposible insertar un dato tipo OLE en una celda de Excel. Se puede hacer en la hoja pero no quedaría asociada al registro, que es lo que tu deseas.
-
La solución que te ofrezco, y es totalmente válida, es que guardes la dirección de la imagen en la celda, que mientras las tengas todas en la misma carpeta, no comprometerán la integridad de tu Base de Datos.
-
Lo que tu deseas hacer, sí es posible pero en aplicaciones de Bases de Datos, en donde los campos pueden tener el tipo de datos OLE.
-
En verdad muchas gracias, sobretodo por tu tiempo empleado, lastima que no se pueda, pero nuevamente muchas gracias, y también por la solución que das, ahora voy a intentar guardar la imagen como dices escribiendo la ruta ... una pregunta más si me lo permites ... crees que sea posible si a las fotos les pongo 1,2,3,.. etc cosa que así en el código al especificar la ruta ponga algo así como un contador para que seleccione la foto, o como crees que se pueda hacer ...¿? ... Pero desde ya muchas gracias ... Saludos .

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas