¿Qué macro utilizó para insertar una imagen en excel con referencia a una celda?

Que tal quisiera solicitar de su apoyo, estoy elaborando un carnet y si coloco Pedro en la celda H12 se muestre la imagen de pedro, esta foto extraerla de una carpeta externa donde tengo todas las fotos, pero también necesito agregar una condición a la macro aquí es donde tengo el problema, te explico: si en la celda H12 escribo andres me muestra la foto de andres hasta ahi estamos bien porque esa foto la tengo en mi base de datos pero enseguida escribo Eduardo pero no tengo esa foto en la carpeta por lo cual me sigue mostrando la foto de andres pero los datos son de eduardo, no se si me explique hasta aquí.

Lo que necesito es que si escribo un nombre que no exista la foto en la carpeta externa me muestre una imagen de no disponible la cual tengo y la nombre "nodisponible".

Me podrían ayudar por favor.

La Macro que tengo es la siguiente:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$H$12" Then
nombre = Target.Value
ActiveSheet.Image1.Picture = LoadPicture("C:\certificados\" & nombre & ".jpg")
End If
End Sub

2

2 Respuestas

10.375 pts. Llevo varios años manejando excel y sus macros

Reemplaza tu código por este:

Private Sub Worksheet_Change(ByVal Target As Range)
On Error Resume Next
If Target.Address = "$H$12" Then
nombre = Target.Value
Ruta = "C:\certificados\" & nombre & ".jpg"
If Existe(Ruta) Then
'Existe el archivo
ActiveSheet.Image1.Picture = LoadPicture(Ruta)
Else
'No existe el archivo
ActiveSheet.Image1.Picture = LoadPicture("C:\certificados\nodisponible.jpg")
End If
End Sub
Function Existe(Archivo As String) As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Archivo) Then
Existe = True
Else
Existe = False
End If
End Function

Adicione una función que comprueba si el archivo de imagen existe.

Espero te sirva.

Feliz dia

Juan Carlos

Muchas gracias Juan Carlos eres muy amable; pero que crees que me aparece un error de compilación

"el tipo de argumento de ByRef no coincide"

y se subraya la primer linea de color amarillo.

Que podemos hacer?

Muchas Gracias.

Eduardo

Copia el siguiente código:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim Ruta As String
On Error Resume Next
If Target.Address = "$H$12" Then
nombre = Target.Value
Ruta = "C:\certificados\" & nombre & ".jpg"
If Existe(Ruta) Then
'Existe el archivo
ActiveSheet.Image1.Picture = LoadPicture(Ruta)
Else
'No existe el archivo
ActiveSheet.Image1.Picture = LoadPicture("C:\certificados\nodisponible.jpg")
End If
End If
End Sub
Function Existe(Archivo As String) As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Archivo) Then
Existe = True
Else
Existe = False
End If
End Function

Feliz dia

Juan Carlos

Wow, de verdad no sabes como te agradezco tu apoyo me sirvió mucho tu colaboración está excelente.

Que tengas mucho éxito.

Gracias.

Finaliza la pregunta.

Un abrazo

Juan Carlos

Estoy usando parte de esta macro y me aparece "error de compilación: no se ha definido variable" y se pone en amarillo "fso =".
Esta es la macro:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPict As Variant
Dim PictureLoc As String
Dim Nodisponible As String

If Target.Address = Range("N3").Address Then

PictureLoc = "C:\Fotos_Anexo_01\" & Range("N3").Value & ".jpg"
Nodisponible = "C:\Fotos_Anexo_01\nodisponible.jpg"

If Existe(PictureLoc) Then

ActiveSheet.Pictures.LoadPicture (PictureLoc)
Else

ActiveSheet.Picture.LoadPicture = (Nodisponible)

End If
End If
End Sub
Function Existe(Archivo As String) As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Archivo) Then
Existe = True
Else
Existe = False
End If
End Function

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)

Dim myPict As Variant
Dim PictureLoc As String
Dim Nodisponible As String

If Target.Address = Range("N3").Address Then

PictureLoc = "C:\Fotos_Anexo_01\" & Range("N3").Value & ".jpg"
Nodisponible = "C:\Fotos_Anexo_01\nodisponible.jpg"

If Existe(PictureLoc) Then

ActiveSheet.Pictures.LoadPicture (PictureLoc)
Else

ActiveSheet.Picture.LoadPicture = (Nodisponible)

End If
End If
End Sub
Function Existe(Archivo As String) As Boolean
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FileExists(Archivo) Then
Existe = True
Else
Existe = False
End If
End Function

Añade tu respuesta

Haz clic para o

Más respuestas relacionadas