Adaptar dos macros para un uso en común
¿Cómo están?, tengo dos macros con un eso diferente pero relacionad y le da el tamaño de una celda
La primer macro me inserta una imagen
Insertar imágenes (a elección del usuario)
Sub InsertaImagen()
'Se selecciona la celda donde deba ser ubicada la imagen
ActiveCell.Select
'Al cancelar insertar imagen (cerrar el cuadro de dialogo), me da un error,
'para evitar esto pongo la siguente linea
On Error Resume Next
'busca en el directorio el archivo de imagen a cargar
With ActiveSheet.Pictures.Insert(Application.GetOpenFilename)
'lineaas para inserat la imagen y ajustar al tamaño de la celda seleccionada
.ShapeRange.LockAspectRatio = 0
.Top = ActiveCell.MergeArea.Top
.Left = ActiveCell.MergeArea.Left
.Width = ActiveCell.MergeArea.Width
.Height = ActiveCell.MergeArea.Height
.ShapeRange.ZOrder 1
End With
End Sub
Mientras que la segunda macro funciona al seleccionar la imagen cargada por la anterior macro, la cual la redimensiona y mueve al rango especifico, eh intentado hacer 1 sola macro de las dos, o llamar a la 2da macro desde la primera, pero no hay efecto dando que la 2da macro solo funciona al seleccionar cualquier imagen.
La idea es que una vez puesta la imagen con la macro 1, la 2da imagen la redimensione y mueva al rango establecido.
No se como hacer para quitar la propiedad si es que así se le puede llamar y que la segunda macro no requiera tener una imagen seleccionada.
Muchas gracias a todo!
Sub ajusta_foto()
tope = Range("A1:AD15").Top
izq = Range("A1").Left
Alto = Range("A1:AD15").Height
Ancho = Range("A16:AD16").Width
'se ubica la imagen sobre la celda G10
Selection.ShapeRange.Top = tope
Selection.ShapeRange.Left = izq
Selection.ShapeRange.Height = Alto
Selection.ShapeRange.Width = Ancho
Selection. ShapeRange. IncrementLeft 4
Selection. ShapeRange. IncrementTop 4
End Sub
1 respuesta
Probala de esta manera:
Sub InsertaImagen()
'x Elsamatilde
'Se toman las dimensiones de la celda donde deba ser ubicada la imagen
tope = Range("A1:AD15").Top
izq = Range("A1").Left
Alto = Range("A1:AD15").Height
Ancho = Range("A16:AD16").Width
'se ubica la imagen sobre la celda activa (G10? )... revisar
ActiveCell.Select
'Al cancelar insertar imagen (cerrar el cuadro de dialogo), me da un error,
'para evitar esto pongo la siguente linea
On Error Resume Next
'busca en el directorio el archivo de imagen a cargar
With ActiveSheet.Pictures.Insert(Application.GetOpenFilename)
'lineaas para inserat la imagen y ajustar al tamaño de la celda seleccionada
.ShapeRange.LockAspectRatio = 0
.Top = tope
.Left = Izq
.Width = Ancho
.Height = Alto
. ShapeRange. IncrementLeft 4
. ShapeRange. IncrementTop 4
.ShapeRange.ZOrder 1
End With
End Sub
