Grafik größer und wieder kleiner, ohne select

Forumthread: Grafik größer und wieder kleiner, ohne select
6 Beiträge zu diesem Forumthread
Anzeige

Forumthread: Grafik größer und wieder kleiner, ohne select

20.02.2025 12:33:45

Dieter(Drummer)

Guten Morgen an alle.

Mit meinem Code wird eine Grafik größer und nach Verlauf der Millisekunden wieder kleiner. Das funktioniert.

Frage: Wie muss der Code lauten, ohne Select und jeweils ohne [A1].Select.

Mit der Bitte um Hilfe, grüßt
Dieter(Drummer)

Public Declare Sub Sleep _

Lib "kernel32" ( _

ByVal dwMilliseconds As Long)



Sub Gross_Klein()

ActiveSheet.Shapes.Range(Array("Grafik 5")).Select

Selection.ShapeRange.ScaleWidth 1.1, msoFalse, msoScaleFromMiddle

    Selection.ShapeRange.ScaleHeight 1.1, msoFalse, msoScaleFromMiddle

 [A1].Select



Sleep 1000



ActiveSheet.Shapes.Range(Array("Grafik 5")).Select

Selection.ShapeRange.ScaleWidth 0.9, msoFalse, msoScaleFromMiddle

    Selection.ShapeRange.ScaleHeight 0.9, msoFalse, msoScaleFromMiddle

 [A1].Select



End Sub

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:08:47

Yal
AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:36:54

Ulf
AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:50:29

Dieter(Drummer)
AW: Geht garnicht

20.02.2025 15:21:20

Dieter(Drummer)
AW: Geht garnicht

20.02.2025 15:42:00

Yal
AW: Geht jetzt

20.02.2025 15:55:48

Dieter(Drummer)

AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:08:47

Yal

Hallo Dieter,

folgende Code sollte funktionieren (nicht getestet). Bitte beachte, dass 90% von 110% nicht 100% sind sondern 99%. Dein Shape wird immer kleiner. Es sei denn Du legst die originale Werte zur Seite und setzt diese wieder ein:

Sub Gross_Klein()

Dim H, W, T, L

    With ActiveSheet.Shapes("Rechteck 1")

        H = .Height

        W = .Width

        T = .Top

        L = .Left

        .ScaleWidth 1.1, msoFalse, msoScaleFromMiddle

        .ScaleHeight 1.1, msoFalse, msoScaleFromMiddle

    

        Application.Wait Now + TimeSerial(0, 0, 3) 'mit Application.Wait brauchst Du keinen "Declare". Teil von Sek können als 0.2 eingegeben werden



        .Top = T

        .Left = L

        .Height = H

        .Width = W

    End With

End Sub

VG
Yal

AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:36:54

Ulf

Hi,

Option Explicit



Public Declare Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)



Public Sub zoomMeUpScotty()

    Dim prop As Double

    prop = 1

    Debug.Print myZoom("Grafik 1", prop) & " " & myZoom("Grafik 2", prop)

End Sub



Public Function myZoom(ByVal strShape As String, Optional dblProp As Double = 1) As Double

    Dim sh As Shape

    Set sh = ActiveSheet.Shapes(strShape)

    With sh

        .SetShapesDefaultProperties

        .ScaleHeight dblProp, msoCTrue

        .ScaleWidth dblProp, msoCTrue

    End With

    Sleep 500

    myZoom = dblProp

End Function

hth
Ulf

AW: Grafik größer und wieder kleiner, ohne select

20.02.2025 15:50:29

Dieter(Drummer)

Hallo Ulf und Damke für Rückmeldung.

Dein Code ist nicht das, was ich meine.

Hier ist eine Musterdatei mit meinem funktionierenden Code und einer Grafik, die bei einem Klick groß und nach Wartezeit wieder kleiner wird.

Gruß,
Dieter(Drummer)
https://www.herber.de/bbs/user/175892.xlsm

AW: Geht garnicht

20.02.2025 15:21:20

Dieter(Drummer)

Danke Yal für Rückmeldung und Code.

Dein Code ergibt lediglich eine Zeitschleife, aber keine optische Veränderung der Grafik, groß und wieder klein.
Mein Code funktioniert ja problemlos,. Es soll ja ledglich ohne Select und ohne [A1].Select sein. Evtl. gibt es ja noch eine Lösung.

Gruß,
Dieter(Drummer)

AW: Geht garnicht

20.02.2025 15:42:00

Yal

Hallo Dieter,

anbei eine Anpassung, die zumindest bei mir funktioniert.
Es gibt keinen ".Repaint

Sub Gross_Klein()

Dim H, W, T, L

    With ActiveSheet.Shapes("Rechteck 1") 'Name anpassen

        H = .Height

        W = .Width

        T = .Top

        L = .Left

        Application.ScreenUpdating = False

        .ScaleWidth 1.1, msoFalse, msoScaleFromMiddle

        .ScaleHeight 1.1, msoFalse, msoScaleFromMiddle

        Application.ScreenUpdating = True

    

        Application.Wait Now + TimeSerial(0, 0, 3)



        .Top = T

        .Left = L

        .Height = H

        .Width = W

    End With

End Sub