Ahora sí, aquí lo dejo por si a alguien le viene bien.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim celda As Range
Dim imgNombre As String
Dim imgOriginal As Shape
Dim imgCopia As Shape
Dim nombreImagenCelda As String
' Solo actuar si el cambio es en una celda individual
If Target.CountLarge > 1 Then Exit Sub
Set celda = Target
nombreImagenCelda = "Imagen_" & celda.Address(False, False)
' Eliminar imagen existente en esa celda (si existe con ese nombre)
On Error Resume Next
Me.Shapes(nombreImagenCelda).Delete
On Error GoTo 0
' Determinar qué imagen usar según el valor
Select Case celda.Value
Case 1: imgNombre = "PruebaEuropa"
Case 2: imgNombre = "PruebaAsia"
Case 3: imgNombre = "PruebaÁfrica"
Case 4: imgNombre = "PruebaAmérica"
Case 5: imgNombre = "PruebaOceanía"
Case 6: imgNombre = "PruebaMarrón"
Case Else: Exit Sub ' No hacer nada si el valor no es válido
End Select
' Buscar la imagen original
On Error Resume Next
Set imgOriginal = Me.Shapes(imgNombre)
On Error GoTo 0
If imgOriginal Is Nothing Then
MsgBox "No se encontró la imagen '" & imgNombre & "'.", vbExclamation
Exit Sub
End If
' Copiar la imagen y colocarla sobre la celda
imgOriginal.Copy
Me.Paste
Set imgCopia = Me.Shapes(Me.Shapes.Count)
With imgCopia
.Top = celda.Top
.Left = celda.Left
.Height = celda.Height
.Width = celda.Width
.LockAspectRatio = msoFalse
.Name = nombreImagenCelda
End With
End Sub
Por
Maku, · publicado
hola, me llamo pero, vivo en castellonenses y estoy interesado en tipo de plantillas de calendarios y calculador de nominas