Macro que pegue imagen en celda con dato
Estoy haciendo una macro que pegue una imagen en una celda solo si contiene dato, si no contiene dato la celda no pegue y pase a otra celda. Solicito su apoyo de favor gracias,
Sub poner_imagen()
' En esta Macro pegaremos la imagen a imprimir verificando en cada rango (celda) seleccionado si esta vacío o_
' Si contiene información. Solo si contiene información se pega la imagen.
' Seleccionamos la imagen y la copiamos
ActiveSheet.Shapes.Range(Array("Picture 71")).Select
Selection. Copy
'Seleccionamos el primer rango a verificar
Range("D5").Select
'Se evalúa si tiene información el Rango(celda)
'Aquí es donde solicito la ayuda para poder dar la instrucción.
'Si el Rango(celda) contiene información pegamos la imagen antes seleccionada.
ActiveCell.Select
ActiveSheet. Paste
'Si no contiene información entonces pasamos al siguiente Rango(celda).
'Seleccionamos la imagen y la copiamos
ActiveSheet.Shapes.Range(Array("Picture 71")).Select
Selection. Copy
'Seleccionamos el segundo rango a verificar
Range("I5").Select
'Se evalúa si tiene información el Rango(celda)
'Aquí es donde solicito la ayuda para poder dar la instrucción.
'Si el Rango(celda) contiene información pegamos la imagen antes seleccionada.
ActiveCell.Select
ActiveSheet. Paste
'Si no contiene información entonces pasamos al siguiente Rango(celda).
End Sub
1 Respuesta
H o l a:
Te anexo la macro actualizada, en la macro van unos comentarios.
Sub poner_imagen()
'Act.Por.Dante Amor
'Ponemos las celdas
celdas = Array("D5", "I5", "N5", "S5")
'copiamos la imagen
ActiveSheet.Shapes.Range(Array("Picture 71")).Select
Selection.Copy
'
'Para cada celda que tiene se verifica si tiene información
For i = LBound(celdas) To UBound(celdas)
If Range(celdas(i)) <> "" Then
'si tiene información pega la imagen
Range(celdas(i)).Select
ActiveSheet.Paste
End If
Next
End SubEn esta instrucción de la macro, debes poner las celdas en las que vas a pegar la imagen:
celdas = Array("D5", "I5", "N5", "S5")