---

Hallo liebe Ex-cel-ten,
möchte in Tabellenblätter sehr verkleinert darstellten Bilder beim anklicken zB. um 300% vergrössern und beim zweiten Klick wieder auf die kleine Version zurückverkleinern.
Habe an ein Makro, das dem Bild zugewiesen wird gedacht. Da ich das fertige Blatt weiter auf unerfahrene Benutze schicken möchte wollte ich diese "Aktion" nicht mit einem Link bei dem das Bild wiedergeladen wäre ausführen.

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Bildinexcelgroesserkleiner.xls.txt

Zitat:

---

Original erstellt von dlabacek:
Habe an ein Makro, das dem Bild zugewiesen wird gedacht.

---

in Zelle A1 10x20/200x400 eingeben, eine grafik einfügen, linke obere Ecke so positionieren das sie in Zelle A1 zum liegen kommt, untenstehendes Makro zuweisen.

Code:

---

Sub Bildgroesserkleiner()
Dim pct As Shape
Dim dblWO As Double, dblHO As Double
Dim dblWN As Double, dblHN As Double
Dim t As String
Set pct = ActiveSheet.Shapes(Application.Caller)
'MsgBox "die obere linke Celle ist " & _
    pct.TopLeftCell.Address
t = pct.TopLeftCell.Value
'MsgBox "Werte der celle sind " & _
    pct.TopLeftCell.value
'alternativ ?
'ptcnname = pct.Name
'ptcHeight = pct.Height
'pctWidth = pct.Width
'lesen der Werte aus Zelle
dblWO = CDbl(Left(t, InStr(t, "x") - 1))
t = Right(t, Len(t) - InStr(t, "x"))
dblHO = CDbl(Left(t, InStr(t, "/") - 1))
t = Right(t, Len(t) - InStr(t, "/"))
dblWN = CDbl(Left(t, InStr(t, "x") - 1))
t = Right(t, Len(t) - InStr(t, "x"))
dblHN = CDbl(t)
With ActiveSheet.Pictures(1)
If Abs(dblWO) < pct.Width * 1.1 - pct.Width Then
pct.Width = dblWO
pct.Height = dblHO
Else
pct.Width = dblWN
pct.Height = dblHN
End If
End With
End Sub

---

Edit: bsp. 187kb angehängt

[Diese Nachricht wurde von Thomas Harmening am 03. Mrz. 2005 editiert.]

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP

---

Genauso hebe ich es mir vorgestell... DER HAMMER

vielen Dank

Eine Antwort auf diesen Beitrag verfassen (mit Zitat/Zitat des Beitrags) IP