Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1732to1736
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Bild Zoomen - Code optimieren

Bild Zoomen - Code optimieren
21.01.2020 16:30:21
Kisska
Hallo zusammen,
Ich benötige eine Art Lupe für die verkleinerten Bilder.
Die eingefügten und verkleinerten Bilder möchte ich mit dem 1. Klick auf 100% skalieren und mit dem 2. Klick die vorher skalierte Größe bekommen.
Beispiel: Das Bild wird eingefügt und an der Zellhöhe angepasst, also auf 20% verkleinert. Mit dem 1. Klick wird das Bild originalgroß vergrößert und zwar auf 100%. Mit dem 2. Klick wird das Bild wieder auf die 20% verkleinert.
Ich habe folgende drei Codes gefunden:
1)

Sub BildVergrössern()
Dim Faktor As Double
With ActiveSheet.Shapes(Application.Caller)
Faktor = IIf(.Width > 300, 1 / 3, 3)
.ScaleWidth Faktor, msoFalse, msoScaleFromTopLeft
.ScaleHeight Faktor, msoFalse, msoScaleFromTopLeft
End With
End Sub

Quelle: http://www.office-loesung.de/ftopic495255_0_0_asc.php
2)

Sub GrossKlein()
Dim objShp As Shape
Dim f As Single, a As Variant
f = 2 'Vergößerungsfaktor
Set objShp = ActiveSheet.Shapes(Application.Caller)
If objShp.AlternativeText = "" Then
With objShp
.AlternativeText = .Width & ";" & .Height
.ScaleWidth f, msoFalse
.ScaleHeight f, msoFalse
End With
Else
With objShp
a = Split(.AlternativeText, ";")
.Width = a(0)
.Height = a(1)
.AlternativeText = ""
End With
End If
Set objShp = Nothing
End Sub

Quelle: https://www.herber.de/forum/archiv/964to968/965850_Bild_vergroessern.html
3)

Dim shp As Shape
Dim big As Single, small As Single
Dim shpDouH As Double, shpDouOriH As Double
big = 3
small = 1
On Error Resume Next
Set shp = ActiveSheet.Shapes(Application.Caller)
With shp
shpDouH = .Height
.ScaleHeight 1, msoTrue, msoScaleFromTopLeft
shpDouOriH = .Height
If Round(shpDouH / shpDouOriH, 2) = big Then
.ScaleHeight small, msoTrue, msoScaleFromTopLeft
.ScaleWidth small, msoTrue, msoScaleFromTopLeft
.ZOrder msoSendToBack
Else
.ScaleHeight big, msoTrue, msoScaleFromTopLeft
.ScaleWidth big, msoTrue, msoScaleFromTopLeft
.ZOrder msoBringToFront
End If
End With

Quelle: https://www.extendoffice.com/documents/excel/4380-excel-click-to-enlarge-image.html
Bei allen drei Codes wird ein Vergrößerungsfaktor angegeben, aber wie kann man eine Prozentangabe machen?
Viele Grüße
Kisska

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild Zoomen - Code optimieren
22.01.2020 22:26:44
Kisska
Hallo Dieter,
leider mangelt es mir an den VBA-Kenntnissen, um das den Code bei mir anzuwenden.
Trotzdem danke für den Link!
Viele Grüße
Kisska

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige