Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1796to1800
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 bei Klick vergrößern

Bild bei Klick vergrößern
11.12.2020 11:43:01
Thomas
Hallo!
Ich hatte am 11-11-2020 eine Super Hilfe bekommen, leider ist nun ein Problem aufgetreten, ich finde aber keine Möglichkeit auf diesen Beitrag zu antworten ...
https://www.herber.de/forum/archiv/1792to1796/t1792456.htm#1792504
Mit dem VBA Code kann ich nun sehr viele Bilder einfügen, die Funktion "Bild_BeiKlick" (das Bild vergrößern und beim zweiten Klick wieder verkleinern) klappt nicht mehr (es wird immer nur verkleinert)
Bei dem ursprünglichen VBA Code wurde dieses Modul aufgerufen:
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' damit Makro nicht sichtbar bei Makro
Public Const DoFaktor = 5 ' Faktor Bildvergrößerung
Sub Bild_BeiKlick()
'* H. Ziplies                                     *
'* 02.12.07                                       *
'* erstellt von Hajo.Ziplies@web.de               *
'* http://Hajo-Excel.de/
Dim ObB As Object                                               ' Variable für Bild
Set ObB = ActiveSheet.Shapes(Application.Caller)                ' das geklickte Bildobjekt  _
auf Variable schreiben
If ObB.Height = ActiveCell.Height - 2 Then                        ' Bildhöhe laut Change  _
Ereignis
ObB.ScaleWidth DoFaktor, msoFalse, msoScaleFromTopLeft      ' Faktor bezogen auf eingefü _
gtes Bild
ObB.ScaleHeight DoFaktor, msoFalse, msoScaleFromTopLeft     ' Faktor bezogen auf eingefü _
tes Bild
ObB.ZOrder msoBringToFront                                  ' Bild in den Vordergrund
Else
ObB.ScaleWidth 1 / DoFaktor, msoFalse, msoScaleFromTopLeft  ' Faktor bezogen auf eingefü _
gtes Bild
ObB.ScaleHeight 1 / DoFaktor, msoFalse, msoScaleFromTopLeft ' Faktor bezogen auf eingefü _
gtes Bild
ObB.ZOrder msoSendToBack                                    ' Bild in den Hintergrund
End If
Set ObB = Nothing                                               ' Variable leeren
End Sub
kann mir jemand sagen wie ich das Bild wieder vergrößern/verkleinern kann?

8
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Bild bei Klick vergrößern
11.12.2020 12:23:26
Mullit
Hallo,
vergrößern + verkleinern ginge damit so:
Sub Bild_BeiKlick()
'**************************************************
'* H. Ziplies                                     *
'* 02.12.07                                       *
'* erstellt von Hajo.Ziplies@web.de               *
'* http://Hajo-Excel.de/                          *
'**************************************************
    Dim ObB As Shape                                               ' Variable für Bild
    Set ObB = ActiveSheet.Shapes(Application.Caller)                ' das geklickte Bildobjekt _
auf Variable schreiben
    If ObB.Height <= ActiveCell.Height - 2 Then                        ' Bildhöhe laut Change _
Ereignis
        ObB.ScaleWidth DoFaktor, msoFalse, msoScaleFromTopLeft      ' Faktor bezogen auf eingefü _
gtes Bild
        ObB.ScaleHeight DoFaktor, msoFalse, msoScaleFromTopLeft     ' Faktor bezogen auf eingefü _
tes Bild
        ObB.ZOrder msoBringToFront                                  ' Bild in den Vordergrund
    Else
        ObB.ScaleWidth 1 / DoFaktor, msoFalse, msoScaleFromTopLeft  ' Faktor bezogen auf eingefü _
gtes Bild
        ObB.ScaleHeight 1 / DoFaktor, msoFalse, msoScaleFromTopLeft ' Faktor bezogen auf eingefü _
gtes Bild
        ObB.ZOrder msoSendToBack                                    ' Bild in den Hintergrund
    End If
    Set ObB = Nothing                                               ' Variable leeren
End Sub

Gruß, Mullit
Anzeige
AW: Bild bei Klick vergrößern
11.12.2020 12:24:09
Rudi
Hallo,
das liegt wohl daran:
If ObB.Height = ActiveCell.Height - 2 Then

ändere mal in
If ObB.BottomRightCell.Address = ActiveCell.Address Then

Gruß
Rudi
AW: Bild bei Klick vergrößern
11.12.2020 12:34:15
Thomas
Hallo Rudi!
Das war es leider nicht, das Bild wird nur immer kleiner ...
Das Modul "BeiKlick" ist in dem VBA Code vom 11-11-2020 "verankert", ist das hier falsch umgesetzt?
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
Const ON_ACTION As String = "Bild_BeiKlick"
Const NO_PICTURE As String = "kein Bild"
Dim strPath As String
Dim strName As String
Dim objShape As Shape
Dim objRange As Range
Dim objCell As Range
Set objRange = Intersect(Target, Range("N2:N200000"))
If Not objRange Is Nothing Then
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
For Each objCell In objRange
objCell.Offset(0, 1).Value = Empty
strName = "Bild " & objCell.Address(False, False)
For Each objShape In Shapes
If objShape.Name = strName Then
objShape.Delete
Exit For
End If
Next
If Not IsEmpty(objCell.Value) Or Not objCell.EntireRow.Hidden Then
strPath = objCell.Text
If Dir$(strPath) = vbNullString Then
objCell.Offset(0, 1).Value = NO_PICTURE
Else
Set objShape = Shapes.AddPicture(strPath, msoFalse, msoTrue, _
objCell.Offset(0, 1).Left + 1, objCell.Top + 1, _
objCell.Width - 2, objCell.Height - 2)
With objShape
.OnAction = ON_ACTION
.Name = strName
.Placement = xlMoveAndSize
End With
End If
End If
Next
Set objRange = Nothing
Set objShape = Nothing
With Application
.EnableEvents = True
.ScreenUpdating = True
End With
End If
End Sub

Anzeige
AW: Bild bei Klick vergrößern
11.12.2020 13:18:42
Mullit
Hallo,
ich machs mal grösser, viell dann...;-)
If ObB.Height <= ActiveCell.Height - 2 Then                        ' Bildhöhe laut Change _
Ereignis

Gruß, Mullit
AW: Bild bei Klick vergrößern
11.12.2020 13:28:16
Thomas
.... OK, ich gehe dann mal zum Optiker :-) DANKE!!
AW: Bild bei Klick vergrößern
11.12.2020 13:30:04
fcs
Hallo Thomas,
Wahrscheinlich ist die Höhe der aktiven Zelle, wenn du auf ein Bild Klicks, anders als die Höhe der Zelle mit der die Höhe der Bilder beim Einfügen festgelegt wurde.
Die Höhe des Bildes wird verglichen auf = ActiveCell.Height -2 , d.h. genaue Übereinstimmung.
Der Vergleich sollte hier auf &lt= erfolgen.
Evtl. ist auch sinnvoller, mit der Zelle zu vergleichen in der sich die linke obere Ecke befindet.
LG
Franz
Option Explicit ' Variablendefinition erforderlich
Option Private Module ' damit Makro nicht sichtbar bei Makro
Public Const DoFaktor = 5 ' Faktor Bildvergrößerung
Sub Bild_BeiKlick()
'* H. Ziplies                                     *modifiziert von F. Sielck
'* 02.12.07                                       *
'* erstellt von Hajo.Ziplies@web.de               *
'* http://Hajo-Excel.de/
Dim ObB As Object                                            ' das geklickte Bildobjekt _
auf Variable schreiben
If ObB.Height 

Anzeige
AW: Bild bei Klick vergrößern
11.12.2020 14:59:59
Thomas
Hallo!
Danke für den Tipp! "Evtl. ist auch sinnvoller, mit der Zelle zu vergleichen in der sich die linke obere Ecke befindet." ist wohl sinnvoll, aktuell klappt das bei 80% beim Rest minimiert das Bild trotzdem und ist dann ganz weg, wenn ich es wieder einfüge , dann klappt das wieder.
Wie macht man den Vergleich denn über die Zelle?
SG Thomas
AW: Bild bei Klick vergrößern
12.12.2020 01:23:24
fcs
Hallo Thomas,
Die entsprechende Anweisung hatte ich schon als Kommentar mit in meinen Vorschlag eingebaut.
    If ObB.Height 

Entferne am Anfang der 3. Zeile das Hochkomma und lösche die ersten beiden Zeilen.
LG
Franz
Anzeige

212 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige