Bild in Excel einfügen das sich bei anklicken vergrößert

[CherryX]

Hallo,

ist es möglich in excel mit dem vba-editor ein Programm zu schreiben, dass die Bilder, wenn man darauf klickt  größer werden. Bei einem erneuten Klick sollten sie wieder klein werden. Das sollte dann gleich für alle Bilder übernommen werden können.

Ist das Möglich wenn Ja wie? Kommt eine Fehlermeldung wenn ich diesen code benutze:

Code:

Const LNG_FAKTOR = 3                      
Dim ARY_ZOOMED_PIC() As Variant

Sub auto_open()
Dim OBJ_PIC As Shape
Dim STR_WKS As Worksheet

For Each STR_WKS In ActiveWorkbook.Sheets
    For Each OBJ_PIC In STR_WKS.Shapes
        OBJ_PIC.OnAction = "ZoomIN_OUT"
    Next OBJ_PIC
Next STR_WKS
ReDim Preserve ARY_ZOOMED_PIC(0)
End Sub
Sub ZoomIN_OUT()
Dim LNG_COUNTER As Long
Dim BOL_ZOOMED As Boolean
BOL_ZOOMED = False
For LNG_COUNTER = 0 To UBound(ARY_ZOOMED_PIC)
    If Application.Caller = ARY_ZOOMED_PIC(LNG_COUNTER) Then
        BOL_ZOOMED = True
        Exit For
    End If
Next LNG_COUNTER

If BOL_ZOOMED = True Then
   
    '//Bildname löschen
    ARY_ZOOMED_PIC(LNG_COUNTER) = ""
   
    '//ZoomOUT
    With ActiveSheet.Shapes(Application.Caller)
        .Height = .Height / LNG_FAKTOR
        .Width = .Width / LNG_FAKTOR
    End With
 
Else
    '//Bildname merken
    ReDim Preserve ARY_ZOOMED_PIC(UBound(ARY_ZOOMED_PIC) + 1)
    ARY_ZOOMED_PIC(UBound(ARY_ZOOMED_PIC)) = Application.Caller

    '//ZoomIN
    With ActiveSheet.Shapes(Application.Caller)
        .Height = .Height * LNG_FAKTOR
        .Width = .Width * LNG_FAKTOR
    End With
End If

End Sub

[chris-ka]

Hi,

aus
http://www.ms-office-forum.net/forum/sho...p?t=335259

ähnlicher Effekt


  PictureZoom.xlsm (Größe: 61,22 KB / Downloads: 16)

[snb]

Oder

Code:

Sub M_snb()
    With Tabelle1.Shapes(Application.Caller)
       .Height = IIf(.Height < 60, 600, 52)
       .Width = IIf(.Height < 60, 52, 200)
     End With
End Sub