Ayuda con Imágenes Insertadas Macros
Edwin buenas tardes. Necesito tu apoyo para resolver dos asuntos particulares. Estoy haciendo un catálogo de productos el cual inserta 5 imágenes a la vez en celdas que están COMBINADAS. Las imágenes las extrae de una carpeta que está en el mismo directorio. Esto ya está resuelto y lo hacer muy bien. También, antes de insertar las siguientes 5 imágenes, borra las anteriores para evitar que la hoja se sature. Eso también lo hace. El problema es que tengo imágenes que no tienen el mismo tamaño: algunas son cuadradas y otras rectangulares. Las que son cuadradas caben dentro de las celdas combinadas, pero las rectangulares se salen en su altura del área de celdas combinadas.
Otro detalle es que todas las imágenes las coloca partiendo de la esquina superior izquierda pero quisiera saber si hay alguna instrucción que las centre en las celdas combinadas y si la imagen es más grande que la ajuste al tamaño de las celdas combinadas GUARDANDO SUS PROPORCIONES.
Espero haberme explicado y te anexo el código para que tengas una mejor visión de lo que deseo plantear. Gracias de antemano por tu valiosa ayuda.
Private Sub Imagen_Siguiente()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123654"
Application.StatusBar = "Procesando la información.... Favor de esperar"
' Rutina para eliminar cualquier imágen insertada antes de darle "siguiente" o "atrás"
Control = Range("CA12").Value
If Control <> "" Then
For I = 12 To 16
Nombre = Range("CA" & I).Value
On Error Resume Next
ActiveSheet.Shapes(Nombre).Select
ActiveSheet.Shapes(Nombre).Delete
Next
Else
End If
' Se inserta la imagen 1 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_2.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto1 = Selection.Name
Range("CA12") = Foto1
'se obtiene la ubicación de la celda Q11
tope = Range("Q11:Y18").Top
izq = Range("Q11:Y18").Left
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
'se ubica la imagen sobre la celda Q11
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 2 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto2 = Selection.Name
Range("CA13") = Foto2
'se obtiene la ubicación de la celda Q20
tope = Range("Q20:Y27").Top
izq = Range("Q20:Y27").Left
alto = Range("Q20:Y27").Height
ancho = Range("Q20:Y27").Width
'se ubica la imagen sobre la celda Q20
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 3 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Avellana_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto3 = Selection.Name
Range("CA14") = Foto3
'se obtiene la ubicación de la celda Q29
tope = Range("Q29:Y36").Top
izq = Range("Q29:Y36").Left
alto = Range("Q29:Y36").Height
ancho = Range("Q29:Y36").Width
'se ubica la imagen sobre la celda Q29
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 4 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto4 = Selection.Name
Range("CA15") = Foto4
'se obtiene la ubicación de la celda D29
tope = Range("D29:L36").Top
izq = Range("D29:L36").Left
alto = Range("D29:L36").Height
ancho = Range("D29:L36").Width
'se ubica la imagen sobre la celda D29
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 5 Amplificada
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto5 = Selection.Name
Range("CA16") = Foto5
'se obtiene la ubicación de la celda AC12
tope = Range("AC12:AX28").Top
izq = Range("AC12:AX28").Left
alto = Range("AC12:AX28").Height
ancho = Range("AC12:AX28").Width
'se ubica la imagen sobre la celda AC12
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
Range("AB9").Select
End Sub
Otro detalle es que todas las imágenes las coloca partiendo de la esquina superior izquierda pero quisiera saber si hay alguna instrucción que las centre en las celdas combinadas y si la imagen es más grande que la ajuste al tamaño de las celdas combinadas GUARDANDO SUS PROPORCIONES.
Espero haberme explicado y te anexo el código para que tengas una mejor visión de lo que deseo plantear. Gracias de antemano por tu valiosa ayuda.
Private Sub Imagen_Siguiente()
Application.DisplayAlerts = False
Application.ScreenUpdating = False
ActiveSheet.Unprotect Password:="123654"
Application.StatusBar = "Procesando la información.... Favor de esperar"
' Rutina para eliminar cualquier imágen insertada antes de darle "siguiente" o "atrás"
Control = Range("CA12").Value
If Control <> "" Then
For I = 12 To 16
Nombre = Range("CA" & I).Value
On Error Resume Next
ActiveSheet.Shapes(Nombre).Select
ActiveSheet.Shapes(Nombre).Delete
Next
Else
End If
' Se inserta la imagen 1 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_2.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto1 = Selection.Name
Range("CA12") = Foto1
'se obtiene la ubicación de la celda Q11
tope = Range("Q11:Y18").Top
izq = Range("Q11:Y18").Left
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
'se ubica la imagen sobre la celda Q11
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 2 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto2 = Selection.Name
Range("CA13") = Foto2
'se obtiene la ubicación de la celda Q20
tope = Range("Q20:Y27").Top
izq = Range("Q20:Y27").Left
alto = Range("Q20:Y27").Height
ancho = Range("Q20:Y27").Width
'se ubica la imagen sobre la celda Q20
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 3 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Avellana_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto3 = Selection.Name
Range("CA14") = Foto3
'se obtiene la ubicación de la celda Q29
tope = Range("Q29:Y36").Top
izq = Range("Q29:Y36").Left
alto = Range("Q29:Y36").Height
ancho = Range("Q29:Y36").Width
'se ubica la imagen sobre la celda Q29
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 4 miniatura
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto4 = Selection.Name
Range("CA15") = Foto4
'se obtiene la ubicación de la celda D29
tope = Range("D29:L36").Top
izq = Range("D29:L36").Left
alto = Range("D29:L36").Height
ancho = Range("D29:L36").Width
'se ubica la imagen sobre la celda D29
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
' Se inserta la imagen 5 Amplificada
Ruta = ThisWorkbook.Path
Ruta = Ruta & "\Ambar_1.jpg"
ActiveSheet.Pictures.Insert(Ruta).Select
Foto5 = Selection.Name
Range("CA16") = Foto5
'se obtiene la ubicación de la celda AC12
tope = Range("AC12:AX28").Top
izq = Range("AC12:AX28").Left
alto = Range("AC12:AX28").Height
ancho = Range("AC12:AX28").Width
'se ubica la imagen sobre la celda AC12
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = alto
Selection.ShapeRange.Width = ancho
Range("AB9").Select
End Sub
1 Respuesta
Respuesta de edwinhenao
1
Para la imágenes rectangulares tendrías que hacer un rango rectangular o transformarlas antes de insertarla en Excel...
Para darle nombre a la imagen es al revés... es decir hay que cambiar:
...
Foto1 = Selection.Name
................ Por ............
Selection.Name = "Foto1"
Otra cosa importante es que al pasar el ancho y el alto igual la imagen quedará cuadrada.
...
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
...
Pero si la imagen es rectangular entra a jugar la relación de aspecto y seguirá rectangular, si quieres que la imagen quede cuadrada, al momento de insertarla la puedes hacer cuadrada algo como ...
...
Worksheets(1). Shapes. AddPicture("C:\Ambar_2.jpg", True, True, 100, 100, 70, 70).Select
...
Y luego lo cuadras en el rango...
...
' Se obtiene la ubicación de la celda Q11
tope = Range("Q11:Y18").Top
izq = Range("Q11:Y18").Left
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
' Se ubica la imagen sobre la celda Q11
Selection.ShapeRange.Top = tope + 10
Selection.ShapeRange.Left = izq + 10
...
Para que quede centrada le puedes sumar al Top y al Left y así no quedará desde la esquina superior, observa que al código de arriba en top y left se les sumo 10.
Éxitos no olvides calificar para cerrar la pregunta.
Para darle nombre a la imagen es al revés... es decir hay que cambiar:
...
Foto1 = Selection.Name
................ Por ............
Selection.Name = "Foto1"
Otra cosa importante es que al pasar el ancho y el alto igual la imagen quedará cuadrada.
...
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
...
Pero si la imagen es rectangular entra a jugar la relación de aspecto y seguirá rectangular, si quieres que la imagen quede cuadrada, al momento de insertarla la puedes hacer cuadrada algo como ...
...
Worksheets(1). Shapes. AddPicture("C:\Ambar_2.jpg", True, True, 100, 100, 70, 70).Select
...
Y luego lo cuadras en el rango...
...
' Se obtiene la ubicación de la celda Q11
tope = Range("Q11:Y18").Top
izq = Range("Q11:Y18").Left
alto = Range("Q11:Y18").Height
ancho = Range("Q11:Y18").Width
' Se ubica la imagen sobre la celda Q11
Selection.ShapeRange.Top = tope + 10
Selection.ShapeRange.Left = izq + 10
...
Para que quede centrada le puedes sumar al Top y al Left y así no quedará desde la esquina superior, observa que al código de arriba en top y left se les sumo 10.
Éxitos no olvides calificar para cerrar la pregunta.
