Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
1964to1968
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

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
Anzeige
AW: Klick Code kürzen
09.02.2024 09:27:21
daniel
Hi

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
Anzeige
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
Anzeige
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)

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige