Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender

Forumthread: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement

Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
30.05.2024 12:49:23
Excelfan1
Hallo zusammen,
ich benötige bitte eure Hilfe.
Ich habe im Tabellenblatt1 für die Zelle C2 eine Auswahl erstellt, Quelle ist Tabellenblatt2 Tabelle2!$E$3:$E$6 mit dem Namen "Tabelle4". Diese enthält die Werte Brot, Milch, Käse, nichts.

Ferner habe ich eine Tabelle "Option" mit 2 Spalten im Tabellenblatt2 mit Kriterien.
Wird nun in Tabellenblatt1 in der Zelle C2 z.B. Brot ausgewählt wird die Tabelle Option entsprechend gefiltert (Spalte1) und es werden im Tabellenblatt1 so viele Checkboxen vom Typ Formularsterelement erzeugt wie oft der ausgewählte Wert in Tabelle Optionen enthalten ist (bei Brot 5 Checkboxen ). Die erste Checkbox erscheint in Zellen B5, die letzte in Zelle B9.

Ich hätte jetzt gerne, daß Checkboxen vom Typ Activex erstellt werden die auch in den Zellen B5 bis B9 erscheinen.
Ich weiß, daß Checkboxen vom Typ Activex OLEObjects heißen, aber CheckBox einfach durch OLEObjects ersetzen funktioniert nicht.
Es erscheint der Fehler "Laufzeitfehler '438' Objekt unterstützt dies Eigenschaft oder Methode nicht".

Kann mir bitte jemand weiterhelfen

Mein derzeitiger Code lautet
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)


If Target = Range("Auswahl") Then
OptionenAnzeigen

End If
End Sub

Private Sub delChkBoxes()
Dim e As CheckBox
For Each e In ActiveSheet.CheckBoxes
e.Delete
Next
End Sub

Private Sub OptionenAnzeigen()
Dim chk As CheckBox
Dim c As Range

Set c = ActiveCell
Call delChkBoxes

Sheets("Tabelle2").ListObjects("Option").Range.AutoFilter Field:=1, Criteria1:=Range("Auswahl").Text

Dim i As Integer
i = Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count
Dim zeile As Integer, spalte As Integer
Dim zelle As Range

spalte = 2: zeile = 4
For i = 1 To Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count
Set zelle = Cells(zeile + i, spalte)
Set chk = ActiveSheet.CheckBoxes.Add(zelle.Left, zelle.Top, 30, zelle.Height)
chk.Text = Range("Option").SpecialCells(xlCellTypeVisible).Cells(i, 2)
Next

c.Select

End Sub


Anzeige

30
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
30.05.2024 13:46:58
daniel
Hi
Zeichnet der Recorder da nichts auf?
Als Workaround könntest du auch eine feste Checkbox als Vorlage erstellen, welche du kopierst und in die Zelle einfügst.

Allerdings sind Steuerelemente, die zur Laufzeit und in dynamischer Anzahl erstellt werden, nichts für den Level "VBA nur mit Recorder".
Etwas einfacher bezüglich des erforderlichen Prigrammierniveaus wäre es gegebenfalls, die dynamischen Checkboxen durch eine feste Multiselect-Listbox zu ersetzen, welcher man dann einfach die entsprechenden Elemente hinzufügen oder auch wieder wegnehmen kann (.Additem, .removeitem)

Bei einem festen Steuerelement kann man auch einfacher eine Programmierung hinterlegen als bei einem dynamisch erzeugtem

Gruß Daniel
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
30.05.2024 17:32:54
Excelfan1
Hallo Daniel, hallo Beverly,
danke daß ihr euch meines Problem angenommen habt.

Leider sind beide Vorschläge für mich nicht brauchbar, da später noch Zellen eingefäbt werden sollen auf Grundlage der erzeugten Checkboxen.
Entschuldigung, daß ich vergessen habe noch folgende Information bereitzustellen:
Die Checkboxen haben dann den Text der auf Grund der Auswahl (Tabelle1, Zelle C2) entsteht. Das habt ihr aber sicher aus meinem Code erkannt.
Wenn man den Text der erzeugten Checkbox auslesen könnte wäre das die Ideallösung.
Aber das, glaube ich, geht nicht.

Ich lade mal meine Datei hoch. In dieser habe ich beschrieben was bezüglich der Zellfärbung passieren soll.

https://www.herber.de/bbs/user/169791.xlsm
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
30.05.2024 21:02:04
Alwin Weisangler
Hallo,

deine gewünschte Änderung --> ActiveX Checkboxen:


Option Explicit

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If Target = Range("Auswahl") Then
OptionenAnzeigenNeu
End If
End Sub

Sub OleButtonsDel()
Dim olObj As Object
For Each olObj In ActiveSheet.OLEObjects
If olObj.OLEType = 2 Then
olObj.Delete
End If
Next olObj
End Sub

Private Sub OptionenAnzeigenNeu()
Dim cntChk As Object
Dim c As Range, zelle As Range
Dim i&, Zeile&, Spalte&

Set c = ActiveCell
OleButtonsDel
Sheets("Tabelle2").ListObjects("Option").Range.AutoFilter Field:=1, Criteria1:=Range("Auswahl").Text
Spalte = 2: Zeile = 4
For i = 1 To Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count
Set zelle = Cells(Zeile + i, Spalte)
zelle.Select
Set cntChk = Sheets("Tabelle1").OLEObjects.Add("Forms.CheckBox.1")
With cntChk
.Object.Caption = Range("Option").SpecialCells(xlCellTypeVisible).Cells(i, 2)
.Width = 50
.Height = 20
End With
Next
c.Select
End Sub

Die Checkboxen auslesen geht über Klasse.
Soll z.B. Häkchen in Checkbox1 (B5) gesetzt die Zelle F5 gefärbt werden?
Soll z.B. Häkchen in Checkbox2 (B6) gesetzt die Zelle F6 gefärbt werden?
usw.

Gruß Uwe
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
30.05.2024 22:29:08
Alwin Weisangler
Ich hoffe, dass mit Häkchen setzen (CheckBox.Caption=Wert der Zelle) die passende Zelle einzufärben der korrekte Weg ist.
https://www.herber.de/bbs/user/169796.xlsm

Gruß Uwe



AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
31.05.2024 10:03:08
Excelfan1
Hallo Beverly, hallo Uwe,

ich bin begeistert!, von beiden Lösungen.

Vielen herzlichen Dank
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
01.06.2024 13:01:31
Excelfan1
Uwe und/oder Beverly, ich muß euch leider noch einmal bemühen.
Ich habe jetzt Stunden zugebracht die Zellfarbe anhand von Kriterien zu ändern. Leider, auch beim Durchforsten des Internets, ohne Erfolg.

Die gefundenen Zellen sollen gleich, wenn die Checkboxen erzeugt wurden, gelb sein.
Bei Beverlys Lösung kein Problem,
bei Uwes Lösung, da hab ich diverses ausprobiert. Leider ohne Erfolg.

In den Spalten K bis P werden Werte eingetragen.
Die Zellfarbe soll sich nun beim Anklicken der Checkbox anhand bestimmter Kriterien ändern.
Kriterium für die Zellfabe rot:
Summe der Zellen der Spalten K bis M oder Summe der Zellen der Spalten N bis P in der Zeile, in der die Checkboxen erzeugt wurde, 30
Kriterium für die Zellfabe grün:
Summe der Zellen der Spalten K bis M oder Summe der Zellen der Spalten N bis P in der Zeile, in der die Checkboxen erzeugt wurde, =30

Könnt ihr mir bitte noch einmal helfen.

Ferner, ehe ihr euch über eine Lösung hermacht:
Über den gefundenen Zellen ist ein Bild eingefügt (mit Tranzparenz 50% damit man sieht welcher Wert in den Zellen steht).
Überaus elegant, vom optischen her, wäre es, wenn das Bild keine Transparenz hätte, ich in jede Zelle, die Werte enthält, eine Form (Kreis) einfüge die dann entsprechend der Kriterien gefärbt wird.
Geht so etwas überhaupt? Und wenn ja, wie?
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
01.06.2024 18:48:24
Beverly
Hi,

mein Vorschlag zum Färben der Zellen in Abhängigkeit von der Summe in K:M oder N:P - ergänze den Code für die Erstellung der CheckBoxen wie folgt

Private Sub OptionenAnzeigen()

Dim chk As CheckBox
Dim c As Range
Dim i As Integer
Dim Zeile As Long, Spalte As Integer
Dim zelle As Range

Set c = ActiveCell
Call delChkBoxes

Sheets("Tabelle2").ListObjects("Option").Range.AutoFilter Field:=1, Criteria1:=Range("Auswahl").Text
Range("E5:H9").Interior.ColorIndex = xlNone
i = Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count

Spalte = 2: Zeile = 4
For i = 1 To Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count
Set zelle = Cells(Zeile + i, Spalte)
Set chk = ActiveSheet.CheckBoxes.Add(zelle.Left, zelle.Top, 30, zelle.Height)
chk.Text = Range("Option").SpecialCells(xlCellTypeVisible).Cells(i, 2)
' der CheckBox das Makro zuweisen zum Zellen färben nach Summe
chk.OnAction = "Machen" '== diese Codezeile ergänzt
For Each c In Range(Cells(chk.TopLeftCell.Row, 5), Cells(chk.TopLeftCell.Row, 8))
If chk.Caption > "neu" Then
If c = CLng(chk.Caption) Then c.Interior.Color = vbYellow
End If
Next c
Next
End Sub


Schreibe außerdem folgendes Makro in ein Standardmodul (dieses Makro sollen die CheckBoxen ausführen und die Zelle dann färben):

Sub Machen()

Dim rngZelle As Range
Dim lngZeile As Long
With ActiveSheet.Shapes(Application.Caller)
lngZeile = .TopLeftCell.Row
If .OLEFormat.Object.Text > "neu" Then
For Each rngZelle In Range(Cells(lngZeile, 5), Cells(lngZeile, 8))
If rngZelle = CLng(.OLEFormat.Object.Text) Then
' im Bereich K:M oder N:P Summe=30 dann Grün
If Application.Sum(Range(Cells(lngZeile, 11), Cells(lngZeile, 13))) = 30 Or _
Application.Sum(Range(Cells(lngZeile, 14), Cells(lngZeile, 16))) = 30 Then
rngZelle.Interior.Color = vbGreen
End If
' im Bereich K:M oder N:P Summe30 dann Rot
If Application.Sum(Range(Cells(lngZeile, 11), Cells(lngZeile, 13))) 30 And _
Application.Sum(Range(Cells(lngZeile, 14), Cells(lngZeile, 16))) 30 Then
rngZelle.Interior.Color = vbRed
End If
End If
Next rngZelle
End If
End With
End Sub


Frage: weshalb sollen denn noch zusätzlich irgendwelche Shapes in der entsprechenden Farbe benutzt werden wenn es auch mit der Zellfarbe geht? Das ist m.E. nur "unnütze Spielerei" ;-)))

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
01.06.2024 20:31:11
Excelfan1
Hallo Beverly,

funktioniert einwandfrei. Ich hab nur im Code bei Zellfarbe rot das "and" in "or" geändert.
Ganz lieben Dank für deine Mühe

Was die Shapes betrifft hast du Recht, es ist eine Spielerei.
Deshalb hatte ich geschrieben "Überaus elegant, vom optischen her"

LG Excelfan1

Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
01.06.2024 21:55:17
Beverly
Hi,

ich kann es logisch nicht nachvollziehen, eigentlich müsste im 2. Teil für die Farbe Rot bei 30 im Code ebenfalls Or und nicht And stehen, aber bei mir funktioniert das System nur, wenn im 2. Teil ein And und kein Or steht - andernfalls wird nie Grün sondern immer nur Rot gefärbt, auch wenn die Summe in einem der Teilbereiche =30 ist.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
02.06.2024 13:18:40
Excelfan1
Hi Beverly,
danke daß du noch einmal geantwortet hast.
Ich hatte das gestern nicht ausführlich genug getestet.
Und es widerspricht auch meiner Logik.
Ich hab jetzt nochmal ausführlich getestet. Es funktioniert so wie es soll wirklich nur mit And im zweiten Teil.
Sehr seltsam. Aber ich bin glücklich, daß es funktioniert.
Nochmal vielen Dank
Anzeige
AW: Checkboxen ActiveX erzeugen statt Typ Formularsteuerelement
03.06.2024 14:37:16
Excelfan1
Zwei Fragen habe ich noch.

1. Ich möchte gerne noch Bilder einfügen.
Die Bildnamen enthalten den Text aus der Auswahlliste. Die ist inzwischen in Zelle X3.
Ich habe das mit einer Case Anweisung gemacht
-----------------------------------------------------
Makro:
Sub BildMilch()
Range("U9").Select
ActiveSheet.Pictures.Insert( _
"mein Bildpfad\Bild Milch.jpg").Select
End Sub
--------------------------------------------------------
Private Sub Worksheet_Change(ByVal Target As Range)
' mit Auswahlbox Bild einfügen

If Target.Address = "$X$3" Then
With ActiveSheet
Call Bild_löschen

Select Case Target
Case "Milch"
Call BildMilch
-----------------------------------------------------

Da es aber viele Bilder sind ... läßt sich das nicht vereinfachen?


2. Die Bilder sollen beim Einfügen 60% Tranzparenz haben.
Geht das?
Wenn ja, wie?

Anzeige
Bilder einfügen
03.06.2024 15:45:50
Beverly
Hi,

verstehe ich das richtig, dass die einzufügenden Bilder immer "Bild Milch.jpg", "Bild Brot.jpg", "Bild Käse.jpg" usw. heißen? Dann kannst du es ganz einfach so realisieren:

Private Sub Worksheet_Change(ByVal Target As Range)

Dim picBild As Picture
If Target.Cells(1).Address(False, False) = "X3" Then
For Each picBild In ActiveSheet.Pictures
If picBild.TopLeftCell.Address(0, 0) = "U9" Then
picBild.Delete
Exit For
End If
Next picBild
If Dir("meinBildfpad\Bild " & Target.Cells(1).Value & ".jpg") > "" Then
ActiveSheet.Pictures.Insert ("meinBildpfad\Bild " & Target.Cells(1).Value & ".jpg")
With ActiveSheet.Pictures(ActiveSheet.Pictures.Count)
.Top = Range("U9").Top
.Left = Range("U9").Left
End With
End If
End If
End Sub


Was die Transparenz betrifft: ich weiß nicht ob das überhaupt möglich ist, denn ich denke das hängt davon ab wie deine Bilder beschaffen sind. Zeiche einfach mal mit dem Makrorekorder auf wie du von Hand die Transparenz einstellst und poste den Code.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Bilder einfügen
03.06.2024 17:55:02
Excelfan1
ja das hast du richtig verstanden und
lieben Dank, funktioniert einwandfrei :-)

Was die Transparenz angeht, das scheint nicht zu gehen, der Rekorder zeichnet nur auf:
ActiveSheet.Shapes.Range(Array("Picture 2")).Select
Range("E1").Select

Inzwischen ist aber noch ein neues Problem bzgl. ändern der Zellfarbe aufgetaucht.
Dein Code wenn Summe 30, oder =30 etc. ist, bezog sich ja auf die jeweilige Zeile in der die Checkbox erzeugt wurde.
Der Wert der Checkbox steht aber nicht zwingend in dieser Zeile.
z.B. die Checkbox mit Text B4 wird in Zelle A2 erzeugt, die Zelle mit Text B4 steht in Zelle W25.

Daß alle Zellen in meiner Range (V7:AJ31), die Werte in dieser Range ändern sich nicht, gelb gefärbt werden habe ich hinbekommen.

Die Summe in Zeile 2 ist 30. Klicke ich nun die Checkbox mit Text B4 bekomme ich gleich eine Fehlermeldung in Excel:
Das Makro kann nicht ausgeführt werden. Das Makro ist möglicher Weise in dieser Arbeitsmappe nicht verfügbar oder alle Makros wurden deaktiviert

Das Makro gibt es und es wurden auch keine Makros deaktiviert.

Gehe ich den Code und führe dort das Makro aus wird bei With ActiveSheet.Shapes(Application.Caller) der Fehler angezeigt.
Fehler: Application.Caller = Fehler 2023.

Wo muß ich im Code etwas ändern, daß der Bezug für das Ändern der Zellfarbe nicht die Zeile sondern meine Range ist?
Anzeige
AW: Bilder einfügen
03.06.2024 18:31:19
Beverly
Hi,

da du ja inzwischen selbst eine ganze Reihe Veränderungen vorgenommen hast solltest du mal deine aktuelle Arbeitsmappe hochladen und auch genau beschreiben, was den/die Fehler auszulöst - ich kann schließlich nicht wild drauflos alles testen.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Bilder einfügen
03.06.2024 23:09:14
Excelfan1
Da hast du Recht, wild drauflos alles testen kannst du nicht.

Die Fehlermeldung in Excel taucht nicht mehr auf, wahrscheinlich hat mein Rechner irgendwas nicht verkraftet.

Gehe ich aber in den Code und führe dort das Makro aus wird bei With ActiveSheet.Shapes(Application.Caller) der Fehler angezeigt.
Fehler: Application.Caller = Fehler 2023.

Meine Datei anbei
https://www.herber.de/bbs/user/169852.xlsm

Bis später
Anzeige
Suchen im Bereich mittels Find
04.06.2024 04:01:28
Beverly
Dieser Fehler ist logisch - der Code besagt ja With ActiveSheet.Shapes(Application.Caller) und das bedeutet: alles bezieht sich auf das aufrufende Objekt. Wenn du nun das Makro einfach von Hand ausführst gibt es kein aufrufendes Objekt - ergo: Fehlermeldung.

Kann es vorkommen, dass die Aufschrift der CheckBox im Bereich V5:AJ29 mehrfach vorkommt oder nur 1 mal? Wenn nur einmalig, dann geht das mit einer einfachen Find-Abfrage:

Sub Farbe()

Dim rngZelle As Range
Dim lngZeile As Long
With ActiveSheet.Shapes(Application.Caller)
lngZeile = .TopLeftCell.Row
If .OLEFormat.Object.Text > "neu" Then
' im Bereich C:G oder I:M Summe=30 dann Grün
If Application.Sum(Range(Cells(lngZeile, 3), Cells(lngZeile, 7))) = 30 Or _
Application.Sum(Range(Cells(lngZeile, 9), Cells(lngZeile, 13))) = 30 Then
' Suche im Bereich V5:AJ29
Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
' gefunden dann Zelle Grün
If Not rngZelle Is Nothing Then rngZelle.Interior.Color = vbGreen
End If
' im Bereich C:G oder I:M Summe30 dann Rot
If Application.Sum(Range(Cells(lngZeile, 3), Cells(lngZeile, 7))) 30 And _
Application.Sum(Range(Cells(lngZeile, 9), Cells(lngZeile, 13))) 30 Then
' suche im Bereich V5:J29
Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
' gefunden dann Zelle Rot
If Not rngZelle Is Nothing Then rngZelle.Interior.Color = vbRed
End If
End If
End With
End Sub


Noch ein kleiner Hinweis: wenn die CheckBox-Aufschrift einfach nur Text ist, kannst du im Code auch einfach nur den Text auslesen - also ohne Umwandlung mit CVar(....). Wenn es sich jedoch um numerische Werte handelt (wie es anfangs der Fall war war) sollten diese sicherheitshalber auch in ein numerisches Format umgewandelt werden.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Suchen im Bereich mittels Find
04.06.2024 09:41:47
Excelfan1
Hallo Beverly,
super !!! Herzlichen Dank !
die Aufschrift der CheckBox im Bereich V5:AJ29 kommt jeweils nur einmal vor.

Eine letzte Frage:
Kann die Zelle der CheckBox, Spalte A, die gleiche Farbe annehmen wie die gefundene Zelle?

LG

AW: Suchen im Bereich mittels Find
04.06.2024 12:10:25
Beverly
Das ist selbstverständlich möglich - ändere den Code an den folgenden beiden Stellen - für Grün:

                ' Suche im Bereich V5:AJ29

Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
' gefunden dann Zelle Grün
If Not rngZelle Is Nothing Then
rngZelle.Interior.Color = vbGreen
.TopLeftCell.Interior.Color = vbGreen
End If


und für Rot:

                ' Suche im Bereich V5:AJ29

Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
' gefunden dann Zelle Rot
If Not rngZelle Is Nothing Then
rngZelle.Interior.Color = vbRed
.TopLeftCell.Interior.Color = vbRed
End If


Mal so als Gedanke am Rande: du verwendest doch CheckBoxen und CheckBoxen haben die Funktionalität, dass man sie aktivieren und deaktivieren kann - derzeit wird der Code ja ausgeführt, gleichgültig ob man sie aktiviert oder deaktiviert. Ich kenne natürlich den Sinn und Zweck deines Projektes nicht, aber wäre es vielleicht sinnvoll, den Code nur ausführen zu lassen wenn sie aktiviert werden? Und wenn sie deaktiviert werden z.B. Farbe der betreffenden Zelle im Bereich V5:AJ21 wieder zurück auf Gelb zu setzen?

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Suchen im Bereich mittels Find
04.06.2024 14:08:31
Excelfan1
Hi Beverly,
wenn sich die Farbe bei aktivieren der CheckBox ändert dann bleibt die Farbe bei deaktiviren erhalten.
Ändert sich die Summe muß ich die Box nochmal anklicken damit die neue Farbe übernommen wird. Die Box hat dann kein Häkchen. Also aktviere ich die Box wieder, die neue Farbe bleibt wieder. Ich klicke die Box also zwei mal an.

Wenn die Box bei deaktiviert wieder zurück auf Gelb gesetzt würde müßte ich sie, wenn sich die Summe ändert, ja nochmal aktivieren für die Übernahme der Farbe. Ich klicke sie also auch in diesem Fall zwei mal an.

So gesehen ist es egal.

Ich möchte mich bei dir nochmal für die großartige Hilfe bedanken

LG von Excelfan1

Anzeige
AW: Suchen im Bereich mittels Find
05.06.2024 05:50:49
Beverly
Du solltest bedenken, dass du mal eine Checkbox versehentlich anklickst und schon stimmt deine ganz Farbänderung nicht mehr - deshalb solltest du m.E. die Möglichket integrieren, dies wieder zurücksetzen zu können: beim Deaktivieren der CheckBoxen Zelle im Bereich V5:AJ29 und die Farbe der Zelle, auf der die jeweilige CheckBox liegt.

Ich nehme an, dass sich die Summe im Bereich durch direkte Eingabe in der jeweiligen Zeile jeder CheckBox ändert und nicht durch eine Formel? Dann kann man völlig problemlos die CheckBox und die zugehörige Zelle im Bereich V5:AJ29 wieder zurücksetzen.

Schau dir einfach mal meinen Vorschlag im Anhang an - ich habe den Code im Codemodul des Tabellenblattes "Karte" für das Ändern im Bereich C:M und das Makro Farbe() entsprechend angepasst.

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

Bis später
Karin

Link zur Homepage: https://excel-inn.de/


Anzeige
AW: Suchen im Bereich mittels Find
05.06.2024 17:53:25
Excelfan1
Hallo Beverly,
nachdem ich eine Nacht drüber geschlafen hatte fand ich deine Idee mit Farbe auf gelb zurücksetzen nicht verkehrt.
Ich wagte es nicht, dich danach zu Fragen. Ist ja Arbeit für dich.
Umso mehr hat es mich gefreut, daß du dich über diese Lösung her gemacht hast. Freu, freu, freu.
Ich habe es gleich mit eingebaut.

Jetzt ist mir doch noch was eingefallen.
Ich möchte gerne alle eingetragenen Werte im Bereich B2:S120 löschen wenn eine neue Auswahl getroffen wird.
Ich habe es über einen CommandButton versucht.
Das klappt nur wenn ich
If Target = Range("Auswahl") Then
OptionenAnzeigen
deaktiviere.
Ist es aktiv, bekomme ich wieder bei If Target = Range("Auswahl") Then einen Fehler.
Laufzeitfehler 13 Typen unverträglich.
Den Fehler hatte ich ja bei Farbänderung schon und du hattest es mit chk.OnAction = "Farbe" gelöst.
Merkwürdig ist, egal ob ich bei der Fehlermeldung auf beenden oder debuggen gehe, die Zellen leeren sich.
Ich habe "Sub leeren" und den CommandButton für die angehängte Beispieldatei mal deaktiviert

Ferner hat sich noch ein Problem bei den Farben eingestellt, da die Farben, je nach Spaltenbereich unterschiedlich sein sollen.
Wenn die Summe 30 ist, dann klappt das mit den Farben einwandfrei.
z.B. Summe(C3:G3)=30, dann grün, Summe(I3:M3)=30, dann rosa, Summe(O3:S3)=30 dann blau.
Aber bei 30 werden die Zellen immer hellblau.
z.B. Summe(C3:G3)30, dann hellgrün, Summe(I3:M3)30, dann hellrosa, Summe(O3:S3)30 dann hellblau.

Drehe ich die abzufragende Reihenfolge um, also erst Bereich O:S, dann I:M, dann C:G, werden die Zellen hellgrün.
Ich verstehe nicht warum.

Ferner hatte ich versucht zu zählen wieviele Zellen grün, rosa, blau sind. Entweder über die Spalte B oder den Bereich V5;AJ31. Das Ergebnis soll dann in AM3 bis AM5 oder gleich als Summe in AM2 stehen.
Eine mögliche Lösung hatte ich in eurem Forum gefunden:
Name definieren, Name bei mir heißt "Farbe1", Bezug ist "=ZELLE.ZUORDNEN(63;INDIREKT("zs(-1)";0))". Zellen in Spalte B "=Farbe1",
Daran scheitert aber jetzt das Ausfüren der Farbänderung. Entferne ich die Formel aus den Zellen in B geht alles wieder.
Dafür gibt es doch bestimmt auch einen Code, oder?

Kannst du dir das bitte mal anschauen.

Dank vorab

LG von Excelfan1

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

Anzeige
AW: Suchen im Bereich mittels Find
05.06.2024 19:42:06
Beverly
Hi,

die Fehlermeldung "Laufzeitfehler 13: Typen unverträglich" in deinem Workbook_SheetChange-Ereignis in der Zeile If Target = Range("Auswahl") Then hängt damit zusammen, dass Target hier ja nur 1 Zelle ist. Da der Code für das Leeren der Zelleinhalte B2:S120 aber auch auf dieses Ereignis zugreift und mehrere Zellen umfasst, soll Target also einerseits eine einzige und andererseits mehrere Zellen sein - und das geht natürlich nicht. Das kann man umgehen, indem man sich auf die 1. Zelle von Target bezieht wenn man die einzelne Zelle anspricht: If Target.Cells(1) = Range("Auswahl") Then

Mit deinen unterschiedlichen Farben gibt es ein generelles Problem, welches du dir noch einmal gründlich durch den Kopf gehen lassen solltest: welcher Spaltenbereich soll denn für die Zelle mit der CheckBox und die Zelle im Bereich V2:AJ29 das Primat haben? Du kannst die Zellen doch nicht gleichzeitig mit mehreren Farben füllen.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Suchen im Bereich mittels Find
06.06.2024 01:04:44
Excelfan1
Hi,
danke erstmal dafür was das leeren der Zellen angeht.

Mit den Farben, da hatte ich den Code versuchsweise erweitert.
für hellgrün
If Application.Sum(Range(Cells(lngZeile, 3), Cells(lngZeile, 7))) 30 And _
Application.Sum(Range(Cells(lngZeile, 9), Cells(lngZeile, 13))) = 0 And _
Application.Sum(Range(Cells(lngZeile, 15), Cells(lngZeile, 19))) = 0 Then
Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
...
für hellrosa
If Application.Sum(Range(Cells(lngZeile, 3), Cells(lngZeile, 7))) = 0 And _
Application.Sum(Range(Cells(lngZeile, 9), Cells(lngZeile, 13))) 30 And _
Application.Sum(Range(Cells(lngZeile, 15), Cells(lngZeile, 19))) = 0 Then
Set rngZelle = Range("V5:AJ29").Find(.OLEFormat.Object.Text, lookat:=xlWhole, LookIn:=xlValues)
...
für hellblau
If Application.Sum(Range(Cells(lngZeile, 3), Cells(lngZeile, 7))) = 0 And _
Application.Sum(Range(Cells(lngZeile, 9), Cells(lngZeile, 13))) = 0 And _
Application.Sum(Range(Cells(lngZeile, 15), Cells(lngZeile, 19))) 30 Then
...

Das hatte aber auch nicht funktioniert.

Ich hab jetzt eine neue Mappe erstellt mit oben genanntem und jetzt funktioniert es.

Bzgl. zählen, wie viele Zellen es in den Farben grün, rosa, blau gibt, hast du da eine Idee?

LG
Anzeige
Farbige Zellen zählen
06.06.2024 05:14:03
Beverly
Hi,

das Zählen geht ganz einfach indem man in einer Schleife über alle Zellen läuft und die Anzahl einfach in eine Variable schreibt:

Sub FarbenZaehlen()

Dim rngZelle As Range
Dim lngFarbe As Long
For Each rngZelle In Range("V2:AJ29")
' alle Zellen zählen die nicht Weiß oder Gelb sind
If rngZelle.Interior.Color > vbYellow And rngZelle.Interior.Color > vbWhite Then lngFarbe = lngFarbe + 1
Next rngZelle
Range("AM2") = lngFarbe
End Sub


Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
AW: Farbige Zellen zählen
06.06.2024 11:08:25
Excelfan1
Hi Beverly,

hab deinen Code jetzt angepaßt, daß es jede Farbe einzeln zählt.
Funktioniert fabelhaft.

Du bist die Beste
Ganz lieben Dank für deinen Einsatz, einfach nur traumhaft
Farbige Zellen zählen
06.06.2024 12:07:17
Beverly
Hi,

naja, du wolltest gleich die Gesamtsumme eingetragen haben... ;-)) Aber ich dachte mir schon dass du das selbst hinbekommst falls du es doch anders haben willst.
Einfach nur interessehalber: wie sieht denn dein angepasster Code aus?

Bis später
Karin

Link zur Homepage: https://excel-inn.de/

Anzeige
AW: Farbige Zellen zählen
07.06.2024 13:08:46
Excelfan1
mein Code sieht so aus

Sub FarbenZaehlen()


Dim rngZelle As Range
Dim lngFarbeGruen As Long
Dim lngFarbeRosa As Long
Dim lngFarbeBlau As Long
Dim lngFarbeOrange As Long

' alle Zellen A2:A120 zählen die Grün sind
For Each rngZelle In Range("A2:A120")
If rngZelle.Interior.Color = &HFF00& Then lngFarbeGruen = lngFarbeGruen + 1
Next rngZelle
Range("AK3") = lngFarbeGruen

' alle Zellen A2:A120 zählen die Rosa sind
For Each rngZelle In Range("A2:A120")
If rngZelle.Interior.Color = &HFF00FF Then lngFarbeRosa = lngFarbeRosa + 1
Next rngZelle
Range("AK4") = lngFarbeRosa

' alle Zellen A2:A120 zählen die Blau sind
For Each rngZelle In Range("A2:A120")
If rngZelle.Interior.Color = &HFFFF00 Then lngFarbeBlau = lngFarbeBlau + 1
Next rngZelle
Range("AK5") = lngFarbeBlau

' alle Zellen A2:A120 zählen die Orange sind
For Each rngZelle In Range("A2:A120")
If rngZelle.Interior.Color = &H80C0FF Then lngFarbeOrange = lngFarbeOrange + 1
Next rngZelle
Range("AK6") = lngFarbeOrange


End Sub
Anzeige
AW: Farbige Zellen zählen
07.06.2024 14:55:21
Beverly
Abschließend folgendes:

- Du musst nicht für jede Farbe die Schleife erneut ausführen, ist nur unnütze Zeitverschwendung. Es reicht 1 Schleife für alle und z.B. in einer Selcet-Case-Anweisung kannst du einfach die betreffende Variable um 1 erhöhen.

- Vielleicht noch eine andere Variante - ich weiß nicht, inwieweit du dich mit Arrays auskennst, aber damit muss man nicht 4 eigene Variablen für jede Farbe deklarieren sondern eine gemeinsame Array-Variable, wobei für jede Farbe jeweils 1 der Arrayfelder zutreffend ist. Beim Schleifendurchlauf erhöht man dann in einer Select-Case-Anweisung in Abhängigkeit von der Farbe einfach nur den Inhalt des betreffenden Array-Feldes um 1. Am Ende gibt man dann den Inhalt des Arrays in einem Ritt im Zielbereich aus:

Sub FarbenZaehlen()

Dim rngZelle As Range
Dim arrFarben()
ReDim arrFarben(0 To 3) ' Array auf 4 Felder festlegen, Zählung der Felder beginnt bei 0
' Arrayfelder mit dem Wert 0 vorbelegen
arrFarben = Array(0, 0, 0, 0)
For Each rngZelle In Range("A2:A120")
' in Abhängigkeit von der gefundenen Farbe die Anzahl im betreffenden Arrayfeld um 1 erhöhen
Select Case rngZelle.Interior.Color
' Farbe Grün - 1. Arrayfeld
Case &HFF00&
arrFarben(0) = arrFarben(0) + 1
' Farbe Rosa - 2. Arrayfeld
Case &HFF00FF
arrFarben(1) = arrFarben(1) + 1
' Farbe Blau - 3. Arrayfeld
Case &HFFFF00
arrFarben(2) = arrFarben(2) + 1
' Farbe Orange - 5. Arrayfeld
Case &H80C0FF
arrFarben(3) = arrFarben(3) + 1
End Select
Next rngZelle
' Arrayinhalt von AK3 bis AK6 auf einen Ritt ausgeben
Range("AK3:AK6") = Application.Transpose(arrFarben())
End Sub


Das Ganze sieht vielleicht wie Spielerei aus, aber ich bin der Meinung, Code sollte man ruhig "so optimal wie möglich" machen und bei sehr umfangreichen Projekten ist eine Optimierung tatsächlich oft eine große Zeitersparnis.

Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
Anderer Lösungsansatz
30.05.2024 16:12:35
Beverly
Hi,

wozu eigentlich irgendwelche CheckBoxen erstellen - hast du mal darüber nachgedacht in der betreffenden Spalte einfach die Schriftart Wingdings zu verwenden und per Doppelklick in die Zellen (oder auch Einfachklick) zwischen den Zeichen Chr(254) - Kästchen mit Häkchen - und Zeichen Chr(168) - Kästchen ohne Häkchen - hin- und herzuwechseln? Dadurch dass du filterst sind doch immer nur die "Kästchen" in den sichtbaren Zellen zu sehen.

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

If Not Intersect(Target, Range("Option")) Is Nothing Then
Cancel = True
If Target = Chr(254) Then
Target = Chr(168)
Else
Target = Chr(254)
End If
End If
End Sub
Anzeige
Formular-CheckBox Caption auslesen
31.05.2024 08:54:48
Beverly
Hi,

wenn es dir nur darum geht auszulesen welche Aufschrift die CheckBox hat um die betreffende Zelle zu färben dann ist das absolut kein Problem mit deinem derzeiten Code und den Formular-Steuerelementen:

Private Sub OptionenAnzeigen()

Dim chk As CheckBox
Dim c As Range
Dim i As Integer
Dim Zeile As Long, Spalte As Integer
Dim zelle As Range

Set c = ActiveCell
Call delChkBoxes

Sheets("Tabelle2").ListObjects("Option").Range.AutoFilter Field:=1, Criteria1:=Range("Auswahl").Text
' Farbe im gesamten Bereich zurücksetzen
Range("E5:H9").Interior.ColorIndex = xlNone
i = Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count

Spalte = 2: Zeile = 4
For i = 1 To Range("Option").SpecialCells(xlCellTypeVisible).Rows.Count
Set zelle = Cells(Zeile + i, Spalte)
Set chk = ActiveSheet.CheckBoxes.Add(zelle.Left, zelle.Top, 30, zelle.Height)
chk.Text = Range("Option").SpecialCells(xlCellTypeVisible).Cells(i, 2)
' Schleife über alle Zellen der laufenden Zeile im Bereich der Spalten E:H
For Each c In Range(Cells(chk.TopLeftCell.Row, 5), Cells(chk.TopLeftCell.Row, 8))
' nur wenn Aufschrift > "neu"
If chk.Caption > "neu" Then
' Aufschrift der CheckBox entspricht Zellinhalt dann Zelle Grün färben
If c = CLng(chk.Caption) Then c.Interior.ColorIndex = 4
End If
Next c
Next
End Sub



Bis später
Karin

Link zur Homepage: https://excel-inn.de/
Anzeige
;

Forumthreads zu verwandten Themen

Anzeige
Entdecke relevante Threads

Schau dir verwandte Threads basierend auf dem aktuellen Thema an

Alle relevanten Threads mit Inhaltsvorschau entdecken
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige