mehrere labels klick ereigniss

tonli2410 · 2024-11-04T12:27:34+00:00

Hallo zusammen, ich habe in einem Tabellenblatt 31 labels die als Button fungieren. Damit springe ich in ein bestimmtes Sheet (SheetName ist in der jeweiligen Zelle) Hier zur Verdeutlichung -> Private Sub Label1_Click() If Range("B5").Value > "" Then Sheets(Cells(5, 2).Value).Select End Sub Private Sub Label2_Click() If Range("B6").Value > "" Then Sheets(Cells(6, 2).Value).Select End Sub Private Sub Label3_Click() If Range("B7").Value > "" Then Sheets(Cells(7, 2).Value).Select End Sub usw. Hat jemand eine Idee wie ich den Code verkleinern kann - Schleife oder so? Vielen Dank im Voraus und beste Grüße Toni

Hallo

ich habe dir mal ein fertiges Makro geschrieben um dein Problem in zwei Schritten zu lösen.
Liste dir bitte zeurst alle Sheets die du anspringen willst in einer Tabelle auf. Bei mir "Tabelle1"
Dann kannst du mit dem 2. Makro 30 Button erstellen, die alle den gleichen Abstand haben.
Das Makro ist schon zuewiesen und klappt bei mir einwandfrei. Der Sheetname muss stimmen!

Zur Zeit werden zum testen nur drei neue Button erstellt. Die Grösse musst du selbst optimieren!
Viel Spass beim Testen. Bin gespannt wie du damit zufrieden bist.

mfg Piet



'alle Tabellern auflisten

Sub Tabellen_auflisten()

With Worksheets("Tabelle1")

     For j = 1 To Worksheets.Count

        Cells(j + 2, 2) = Worksheets(j).Name

     Next j

End With

End Sub





'Button per Makro erstellen

Sub Button_erstellen()

With Worksheets("Tabelle1")

     Links = 72  'Bildschirm Anordnung

     Oben = 27

     Breite = 81  'Grösse deines Buttons

     Höhe = 21

     Makro = "Sprung_zurTabelle"  'Makroname

     

     For j = 1 To 3

         ActiveSheet.Buttons.Add(Links, Oben, Breite, Höhe).Select

         Selection.Characters.Text = .Cells(j + 2, 2)  'Caption

         Selection.Placement = xlMove  'Nur von Platz abhängig

         Selection.OnAction = Makro    'Makro zuweisen

         Oben = Oben + 40   '40= Abstand zum nächsten Button

    Next j

End With

End Sub



'Sprung zur Tabelle

Sub Sprung_zurTabelle()

    Sht = ActiveSheet.Buttons(Application.Caller).Text

    Workbooks(Sht).Select

End Sub

Hi
Wenn du ActiveX-Labels hast, musst du die Klassenprogammierung anwenden.
dh du musst eine eigene Klasse von Labels erstellen. Dann musst du diese Labels dieser Klasse zuweisen und du kannst dann für diese Klasse ein gemeinschaftliches Klick-Event erstellen. Dort musst du dann über die Position des Elements die richtige Zelle ermitteln und dann zu diesem Blatt springen.

etwas einfacher geht es, wenn du statt ActiveX-Labels einfache Grafikelemente erstellst.
diesen kannst du dann ein Makro aus einem allgemeinen Modul zuweisen, welches dann bei Klick ausgeführt wird.
dieses Makro kannst du dann mehreren Grafikelementen zuweisen (über das Kontextmenü)
auch dieses Makro muss dann aus der Position des Labels die richtige Zelle referenzieren, damit ein Makro für alle Labels verwendet werden kann.
das Makro sieht dann so aus:

Sub BeiKlick()

dim Zeile as long

Zeile = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row 'Application.Caller ist der Name des Elements, dass das Makro aufgerufen hat

if Cells(Zeile, 2) > "" Then Sheets(Cells(Zeile, 2).value).Select

End Sub

das setzt voraus, dass das Label mit der linken oberen Ecke in der Zeile liegt, in der der Blattname hinterlegt ist.

am einfachsten jedoch der Vorschlag von Onur, wenn es ok ist einfach einen Doppelklick auf die Zelle, in der der Blattname steht, zu machen (also ganz ohne Labels)
dann reicht das im Modul des Tabellenblatts:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

If Target.Column = 2 Then _

    If Target.Row >= 5 Then _

        If Target.Value > "" Then Sheets(Target.Value).Select

End Sub

Forumthread: mehrere labels klick ereigniss

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

mehrere labels klick ereigniss

Forumthread: mehrere labels klick ereigniss

16 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

16
Beiträge zum Forumthread

Beiträge zu diesem Forumthread