Insertar imagen y aumentarla de tamaño

H o  l a:

• Te anexo la macro actualizada para que no borre tu commandbutton, cambia en la macro "CommandButton1" por el nombre de tu commandbutton.

Private Sub CommandButton1_Click()
'Por.Dante Amor
    Application.ScreenUpdating = False
    'ActiveSheet.DrawingObjects.Delete
    For Each img In ActiveSheet.DrawingObjects
        If img.Name <> "CommandButton1" Then
            img.Delete
        End If
    Next
    '
    u = Range("A" & Rows.Count).End(xlUp).Row
    Rows("1:" & u).RowHeight = 60
    Columns("B:B").ColumnWidth = 15
    ruta = "C:\Users\RUBEN\Desktop\FOTOS\"
    'ruta = "C:\trabajo\fotos\"
    For i = 1 To u
        arch = Dir(ruta & Cells(i, "A") & ".*")
        If arch <> "" Then
            With Cells(i, "B")
                Arriba = .Top + 1
                Izquierda = .Left + 1
                Ancho = .Width - 2
                Alto = .Height - 2
            End With
            '
            Set fotografia = ActiveSheet.Pictures.Insert(ruta & arch)
            With fotografia
                .Placement = xlMoveAndSize
                .ShapeRange.LockAspectRatio = msoFalse
                .Top = Arriba
                .Left = Izquierda
                .Width = Ancho
                .Height = Alto
            End With
            Set fotografia = Nothing
        End If
    Next
    Application.ScreenUpdating = True
    MsgBox "Imágenes insertadas"
End Sub

• Para hacer grande la imagen o pequeña, pon lo siguiente en los eventos de thisworkbook. El siguiente código es para activar la tecla F4, cada que presiones la tecla F4 se ejecutará la macro CrecerImagen.

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.OnKey "{F4}", ""
End Sub
'
Private Sub Workbook_Open()
'Por.Dante Amor
    Application.OnKey "{F4}", "CrecerImagen"
End Sub

Instrucciones para poner la macro en los eventos ThisWorkbook

1. Abre tu libro de excel
2. Para abrir Vba-macros y poder pegar la macro, Presiona Alt + F11
3. Del lado izquierdo dice: VBAProject, abajo dale doble click a ThisWorkbook
4. En el panel del lado derecho copia la macro

• Pon la siguiente macro en un módulo:

Sub CrecerImagen()
'Por.Dante Amor
    On Error Resume Next
    n = Selection.Name
    werr = Err.Number
    If werr <> 0 Then
        MsgBox "Selecciona una gráfica"
        Exit Sub
    End If
    On Error GoTo 0
    If InStr(1, n, "Imagen") = 0 Then
        MsgBox "Selecciona una Imagen"
        Exit Sub
    End If
    If Selection.Height > 400 Then
        Selection.Height = [B1].Height
        Selection.Width = [B1].Width
    Else
        Selection.Height = 450
        Selection.Width = 450
    End If
End Sub

Funcionamiento:

- Guarda el archivo y vuelve abrirlo para que se active la tecla F4.

- Carga las imágenes.

- Revisa que todas las imágenes que se cargaron tienen un nombre como "Imagen 10" o "10 Imagen", el caso es que tengan la palabra "Imagen".

- Selecciona una imagen y presiona la tecla F4

- La imagen crecerá.

- Si presionas nuevamente la tecla F4 la imagen se reducirá.

Cuando cierres el archivo la tecla F4 se desactivará con este evento:

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Por.Dante Amor
    Application.OnKey "{F4}", ""
End Sub

':)
':)