Makros optimieren so das keine 480 notwendig sind

Forumthread: Makros optimieren so das keine 480 notwendig sind

25.11.2024 16:24:29

LSG?

Hallo Zusammen,
ich bastel gerade an deinem Sitzplan. Bestehend aus 240 Sitzplätzen.
Was macht das Makro: beim anklicken einer Cklickbox wird die Zelle rot, schreibt eine Zahl in eine weitere Zelle zum zählen,
blendet die Klickbox aus und blendet eine neue an der selben Stelle ein und schreibt den Platz in eine Zeile in der alle gewählen Plätze
aufgelistet werden.
Wenn ich dann auf die neue Klickbox drücke, wird die Zelle wieder weiß bzw. grau(jede zweite Reihe grau anstatt weiß), löscht die Zahl zum Rechnen,
schreibt "nichtPlatz" und blendet sch aus und blendet die erste Klickbox wieder ein.

Der Sitzplan sieht so aus, das ich 11 Plätze habe und 22 Reihen. Aktuell habe ich 33 Plätze fertig, da ich pro Platz zwei Makros benötige.

Geht das auch einfacher??
Vielleicht hat ja jemand eine Idee.

Sub Makro23()

ActiveSheet.Shapes("Check Box 23").Select

If Selection.Value = xlOn Then

    ActiveSheet.Shapes("Check Box 23").Select

    Selection.Value = xlOff

    ActiveSheet.Shapes.Range(Array("Check Box 23")).Visible = msoFalse

    Range("D6").Select   Achtung die Spalten A-C benötige ich für andere Sachen und die 11 Plätze zwischendrin gehen bis Spalte Q da zwischendrin ebenfalls Leerspalten sind

    With Selection.Interior

        .Pattern = xlSolid

        .PatternColorIndex = xlAutomatic

        .Color = 255

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("T6").Select

    ActiveCell.FormulaR1C1 = "1"

    Range("T1").Select

    Range("C3").Value = Range("C3").Value + "/P23"

    ActiveSheet.Shapes.Range(Array("Check Box 255")).Visible = msoTrue

End If

End Sub

Sub Makro255()

ActiveSheet.Shapes("Check Box 255").Select

If Selection.Value = xlOn Then

    ActiveSheet.Shapes("Check Box 255").Select

    Selection.Value = xlOff

    ActiveSheet.Shapes.Range(Array("Check Box 255")).Visible = msoFalse

    Range("D6").Select

    With Selection.Interior

        .Pattern = xlNone

        .TintAndShade = 0

        .PatternTintAndShade = 0

    End With

    Range("T6").Select

    ActiveCell.FormulaR1C1 = "0"

    Range("T1").Select

    Range("C3").Value = Range("C3").Value + "/nichtP23"

    ActiveSheet.Shapes.Range(Array("Check Box 23")).Visible = msoTrue

End If

End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Makros optimieren so das keine 480 notwendig sind

25.11.2024 16:28:05

{Boris}

Hi,

lad mal bitte eine aussagekräftige Beispieldatei hoch.

VG, Boris

Hmm...

25.11.2024 18:39:57

Yal

gemeint ist natürlich 480 Makros, weil 2 pro Kasten.

Hallo Theo,

lösche die Formel in Zelle A1
lösche alle 480 Makros,
lösche alle 240 Checkboxen. Dafür folgende Code:

Sub AlleShapes_löschen()

Dim S As Shape



    For Each S In Me.Shapes

        S.Delete

    Next

End Sub

Dann füge im Codepane von Tabelle4 diesen Code:

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



    If Not Intersect(Target, Range("D4:F17,H4:J17,L4:N17,P4:Q17,D18:J23,L18:Q23")) Is Nothing Then

        Cancel = True

        If Target.Font.Bold Then

            Target.Font.Bold = False

            Target.Font.Size = 12

            Range("A1") = Application.Min(0, Range("A1") - 1)

        Else

            Target.Font.Bold = True

            Target.Font.Size = 30

            Range("A1") = Range("A1") + 1

        End If

    End If

End Sub

Sonst könnte folgende Code nutzvoll sein:

Public Sub Alles_zurücksetzen()

    With Range("D4:F17,H4:J17,L4:N17,P4:Q17,D18:J23,L18:Q23")

            .Font.Bold = False

            .Font.Size = 12

            Range("A1") = 0

    End With

End Sub

VG
Yal

AW: Makros optimieren so das keine 480 notwendig sind

25.11.2024 16:34:05

LSG?

https://www.herber.de/bbs/user/173808.xlsm

AW: Makros optimieren so das keine 480 notwendig sind

25.11.2024 16:40:23

LSG?

Die Zahl der gesamt ausgewählten Plätze und die Zeile der ausgewählten Plätze gebe ich dann in ein anderes Tabellenblatt weiter.
Und setze dabei die Zahl und die Zeile C3 zurück, sodass ich bei der nächsten Bestellung wieder neue Plätze auswählen kann.

AW: Makros optimieren so das keine 480 notwendig sind

25.11.2024 16:42:40

Onur

Wieso überhaupt so viel Arbeit? Warum nimmst du nicht einfach das Doppelklickevent der Zelle statt 200 Kontrollkästchen (oder 400?) ?

AW: Makros optimieren so das keine 480 notwendig sind

25.11.2024 18:55:36

Piet

Hallo

Doppelklickevent - Prim Idee, wenn man das Makro dazu schreiben kann!
Schaue ich mir aber den Makrorecorder Code in den Modulen an erübrigen sich Worte dazu!

Doppelklick auf die Zelle setzt die Innenfarbe auf Rot. - Rechtsklick setzt die Zelle zurück.
Es gibt zwei Buttons, einen in Tabelle4 zum Liste_löschen, und in Tabelle1 Liste neu laden.
https://www.herber.de/bbs/user/173810.xlsm

mfg Piet

AW: Makros optimieren so das keine 480 notwendig sind

10.12.2024 09:58:24

LSG?

Dankeschön an alle die geantwortet haben.
Hab es gestern mal mit dem Doppelklickevent versucht..
Und es funtioniert. Daran hatte ich gar nicht gedacht.

Makros optimieren so das keine 480 notwendig sind

Forumthread: Makros optimieren so das keine 480 notwendig sind

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Makros optimieren so das keine 480 notwendig sind

Forumthread: Makros optimieren so das keine 480 notwendig sind

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread