Klick Code kürzen

Forumthread: Klick Code kürzen

Klick Code kürzen

09.02.2024 09:20:22

Dieter(Drummer)

Guten Morgen an alle ...

mit dem Code werden 4 Buttons (Shapes) hintereinander per Klick in vertiefendem 3D und zweiter Klick die Buttons wieder in norml 3D dargestellt. Der Code ist von "Herber: Udo (Uduuh), 06.02.2024 15:29:44. Das funktioniert perfekt.

Kann der Code gekürzt werden, dass der gleiche Code nicht 4 x für unterschiedliche Buttons sein muss?

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

Code in Modul1
'Herber: Udo (Uduuh), 06.02.2024 15:29:44

Sub Tief_Hoch_Click() 'Rechteck_Grafik Klick rein raus

  

  With ActiveSheet.Shapes("Picture 1").ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

  'End With



  With ActiveSheet.Shapes("Picture 2").ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

 ' End With

  

  With ActiveSheet.Shapes("Picture 3").ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

  'End With

  

  With ActiveSheet.Shapes("Picture 4").ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

  End With

  End With

 End With

End With



End Sub

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Klick Code kürzen

09.02.2024 09:27:21

daniel
AW: Klick Code kürzen

09.02.2024 09:42:58

Dieter(Drummer)
AW: Klick Code kürzen

09.02.2024 10:52:53

Rolf
AW: Klick Code kürzen

09.02.2024 11:45:46

Dieter(Drummer)

AW: Klick Code kürzen

09.02.2024 09:27:21

daniel

dim Pic 

for each Pic in Array("Picture 1", "Picture 2", "Picture 3", "Picture 4")

  With ActiveSheet.Shapes(Pic).ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

  End With

next

wenn die Namen so sind wie im Beipisel vorliegend, dh gleicher Haupttext mit lückenlos fortlaufender Nummer dann auch einfacher

dim x as long 

for x = 1 to 4

  With ActiveSheet.Shapes("Picture " & x).ThreeD

    .BevelTopType = msoBevelSoftRound 'Mx

    .BevelTopInset = 15 '12

    .BevelTopDepth = 10 '10

    .Visible = Not .Visible

  End With

next

Gruß Daniel

AW: Klick Code kürzen

09.02.2024 09:42:58

Dieter(Drummer)

Danke Daniel,

für beide TOP funtionierenden Codes. Einfach perfekt ...
Danke und noch einen schönen Tag.

Gruß, Dieter(Drummer)

AW: Klick Code kürzen

09.02.2024 10:52:53

Rolf

Hallo Dieter,

du kannst den Namen des jeweils angeklickten Shapes auch direkt mit dem Application.Caller ermitteln.
Dann brauchst du keine Schleifen. Teste mal:

Sub Tief_Hoch_Click() 'Rechteck_Grafik Klick rein raus
Dim strName As String
strName = Application.Caller
With ActiveSheet.Shapes(strName).ThreeD
.BevelTopType = msoBevelSoftRound 'Mx
.BevelTopInset = 15 '12
.BevelTopDepth = 10 '10
.Visible = Not .Visible
End With
End Sub

Gruß Rolf

AW: Klick Code kürzen

09.02.2024 11:45:46

Dieter(Drummer)

Danke Rolf,

eine interessante Variante, die auch gut funktioniert.

Gruß, Dieter(Drummer)

Beliebteste Forumthreads (12 Monate)

Forumthread: Klick Code kürzen

4 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

4
Beiträge zum Forumthread

Beiträge zu diesem Forumthread