Cuando escribo una referencia en la columna "E", que no tenga foto, me salga la foto, 1.Gif.

Te propongo la siguiente opción.

Cuando insertes la foto, en alguna celda de la misma fila escribe el nombre de la foto, para que posteriormente puedas borrar esa foto, ejemplo:

    imgactual = Cells(A, 6)
    If imgactual <> "" Then
        ActiveSheet.Shapes(imgactual).Delete
    End If
    imgactiva = etiqueta.Name
    Cells(A, 6) = imgactiva

Por ejemplo en la fila A (tu contador de fila se llama A), en la columna F, pregunto si es diferente de "" si es diferente de blanco, significa que hay una imagen, entonces borro la imagen con ese nombre que está en la celda

Si está en blanco, significa que no hay imagen, entonces tomo el nombre de la imagen y lo guardo en la celda A, columna F

Buenas tardes Dante

Pero no se como agregar, lo que me dices para probarlo.

La referencia de la foto lo hago en la columna "E" y la foto me sale en la celda "D".

Pero me faltan en determinadas referencias la foto y me interesaría que no me saliera ninguna foto, como ahora pero en las de más celdas me cambian las fotos cuando una referencia no tiene foto, por eso me interesaría que saliera la foto "1.gif".

Y no consigo que se me borre cuando borro la referencia.

Tengo que seleccionar dos o más celdas de la columna "E" para borrarlas.

Un saludo

Pero no sé cómo estás borrando lo que llamas "referencia".

¿Borras con otra macro?

O envíame tu archivo con un par de imágenes y me explicas cómo agregas y cómo quieres borrar

Mi correo [email protected]

En el asunto del correo escribe tu nombre de usuario “luisherrero2” y el título de esta pregunta.

Te lo he mandado pero sin foto te las mando ahora.

Me tengo que marchar a la Eucaristía o Misa.

Vendré por la noche

Un saludo Dante

Te anexo la macro para insertar fotos y para eliminar fotos.

Para insertar fotos:

1. La macro identifica la extensión de la referencia. Si no existe ningún archivo con la referencia, te envía un mensaje de error.

2. Si encuentra la imagen, la inserta y el nombre de la imagen lo escribe en la celda de la columna "D". De esta forma, cuando borres la referencia de la columna "D", la macro que borra, tomará el nombre de la imagen de la columna "D" y borrará la imagen.

Private Sub Worksheet_Change(ByVal Target As Range)
    'Por.Dante Amor
    ActiveSheet.Unprotect Password:="1"
    If Target.Column = 5 Then
        If Cells(Target.Row, "B") = "" Then
            Cells(Target.Row, "B") = Date
        End If
    End If
    '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
    '  Columnas en MAYUSCULAS
    '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
    If Not Application.Intersect(Target, Range("B7:B1200, F7:F1200")) Is Nothing Then
        Target.Value = UCase(Target)
    End If
    '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
    '  F O T O S
    '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
    If Not Intersect(Target, Columns("E")) Is Nothing Then
        If Target.Count > 1 Then Exit Sub
        If Target <> "" Then
            '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
            '  AGREGAR FOTOS
            '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
            'ruta = "C:\trabajo\Fotos\"
            ruta = "G:\Factura\Fotos\"
            imagen = Dir(ruta & Target.Value & ".*")
            If imagen <> "" Then
                imgactual = Cells(Target.Row, "D")
                If imgactual <> "" Then
                    ActiveSheet.Shapes(imgactual).Delete
                End If
                Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
                With etiqueta
                    .ShapeRange.LockAspectRatio = msoFalse
                    .Left = Cells(Target.Row, "D").Left
                    .Top = Cells(Target.Row, "D").Top
                    .Height = Range(Cells(Target.Row, "D"), Cells(Target.Row + 5, "D")).Height 'alto imagen
                    .Width = Cells(Target.Row, "D").Width 'ancho imagen
                End With
                imgactiva = etiqueta.Name
                Cells(Target.Row, "D") = imgactiva
            Else
                MsgBox "La referencia no tiene foto", vbExclamation
            End If
        Else
            '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
            '  Eliminar FOTOS
            '*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
            On Error Resume Next
            If Target.Count > 1 Then Exit Sub
            imgactual = Cells(Target.Row, "D")
            If imgactual <> "" Then
                ActiveSheet.Shapes(imgactual).Delete
            End If
            Cells(Target.Row, "D") = ""
        End If
    End If
End Sub

Saludos.Dante Amor

Buenos días Dante

Me da error en:

Set etiqueta = ActiveSheet.Pictures.Insert(imagen)

Un saludo

¿Probaste con el archivo que te envié?

¿Le cambiaste algo a la macro?

¿Qué mensaje de error te envía?

Buenos días Dante
La macro es la que me has mandado hace 4 horas:
Private Sub Worksheet_Change(ByVal Target As Range)
'Por.Dante Amor
ActiveSheet.Unprotect Password:="1"
If Target.Column = 5 Then
If Cells(Target.Row, "B") = "" Then
Cells(Target.Row, "B") = Date
End If
End If
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Columnas en MAYUSCULAS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Not Application.Intersect(Target, Range("B7:B1200, F7:F1200")) Is Nothing Then
Target.Value = UCase(Target)
End If
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' F O T O S
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
If Not Intersect(Target, Columns("E")) Is Nothing Then
If Target.Count > 1 Then Exit Sub
If Target <> "" Then
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' AGREGAR FOTOS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
'ruta = "C:\trabajo\Fotos\"
ruta = "G:\Factura\Fotos\"
imagen = Dir(ruta & Target.Value & ".*")
If imagen <> "" Then
imgactual = Cells(Target.Row, "D")
If imgactual <> "" Then
ActiveSheet.Shapes(imgactual).Delete
End If
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
With etiqueta
.ShapeRange.LockAspectRatio = msoFalse
.Left = Cells(Target.Row, "D").Left
.Top = Cells(Target.Row, "D").Top
.Height = Range(Cells(Target.Row, "D"), Cells(Target.Row + 5, "D")).Height 'alto imagen
.Width = Cells(Target.Row, "D").Width 'ancho imagen
End With
imgactiva = etiqueta.Name
Cells(Target.Row, "D") = imgactiva
Else
MsgBox "La referencia no tiene foto", vbExclamation
End If
Else
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
' Eliminar FOTOS
'*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*-
On Error Resume Next
If Target.Count > 1 Then Exit Sub
imgactual = Cells(Target.Row, "D")
If imgactual <> "" Then
ActiveSheet.Shapes(imgactual).Delete
End If
Cells(Target.Row, "D") = ""
End If
End If
End Sub

Me da error 1004 y manda depurar y no me sale la imagen:
Set etiqueta = ActiveSheet.Pictures.Insert(imagen)
Un saludo

Prueba con la imagen que me diste

La 4040

Lo que pasa es que tu imagen a de tener alguna extensión que no soporta excel

Pero prueba también con la otra imagen que me enviaste la 7047

Me da error el mismo con las dos fotos

Un saludo Dante