Thema: Bild bei Klick vergrößern und zurücksetzen

StandardModule: basMain

Sub BildGroesse()
   Dim pct As Shape
   Dim dblWidthOld As Double, dblHeightOld As Double
   Dim dblWidthNew As Double, dblHeightNew As Double
   Dim txt As String, txtTmp As String
   Set pct = ActiveSheet.Shapes(Application.Caller)
   txt = pct.TopLeftCell.Value
   dblWidthOld = CDbl(Left(txt, InStr(txt, "x") - 1))
   txt = Right(txt, Len(txt) - InStr(txt, "x"))
   dblHeightOld = CDbl(Left(txt, InStr(txt, "/") - 1))
   txt = Right(txt, Len(txt) - InStr(txt, "/"))
   dblWidthNew = CDbl(Left(txt, InStr(txt, "x") - 1))
   txt = Right(txt, Len(txt) - InStr(txt, "x"))
   dblHeightNew = CDbl(txt)
   With ActiveSheet.Pictures(1)
      If Abs(dblWidthOld) < pct.Width * 1.5 - pct.Width Then
         pct.Width = dblWidthOld
         pct.Height = dblHeightOld
      Else
         pct.Width = dblWidthNew
         pct.Height = dblHeightNew
      End If
   End With
End Sub

Beiträge aus dem Excel-Forum zu den Themen Grafik und Ansicht