Office 2010: Kästchen

[jagga007]

Hallo Leute,

Ich habe in Excel eigene Kästchen erstellt. Grund besser lesbar ich kann Sie mir so erstellen wie ich Sie möchte und, ich muß den Zustand ob aktiviert oder nicht in eine Datenbank übernehmen.

Nun das Gerüst ist eigentlich fertig es funktioniert auch prima. Mit einer Ausnahme beim ersten mal auswählen reagiert das Kästchen nicht, erst beim zweiten mal anklicken dann OK. Beim schließen und wieder öffnen der Datei funktioniert es dann auf das erste mal. Wie wenn dies im Speicher abgespeichert würde.

Ich habe eine Clean Funktion eingebaut die alle Kästchen zurücksetzt aber danach ist es wieder das gleiche wie zu beginn erst beim zweiten mal werden die Kästchen aktiviert.

Meine Frage bzw. bitte ist kennt jemand eine Lösung die wenn ich die Datei öffne und ein Kästchen wähle sofort aktiviert wird und nicht erst auf das zweite mal?

Wäre Super.


Gruß jagga007

[redeagle56]

Hallo jagga007,
was um alles in der Welt sind Kästchen?
Bitte Datei zur Ansicht hier einstellen.

Gruß Günter

[maninweb]

Hallo,

etwas umständlich gelöst, meiner Ansicht nach. Warum hast Du keine Checkboxes verwendet?
Und wenn es Dir nur ums Anklicken geht und es nicht mehr werden, als zu sehen, würden
Formularkontrollkästchen es auch tun.

Reproduzieren kann ich das Verhalten bei mir nicht, allerdings ist anzumerken, dass Du den Steuerelementen
dynamisch ein Ereignis zuweist. Sobald Du z.B. in den Entwurfsmodus gehst, ist diese dynamische Zuordnung
hinüber, d.h. MeineLabels zurückgesetzt. Dann reagieren die auch nicht mehr, solange Du nicht wieder den
Code zur Zuordnung laufen lässt.

Noch ein Tipp am Rande: das Ausblenden der Zeilen verlangsamt die Mappe deutlich.

Gruß

[jagga007]

Hallo Ihr beiden,

Ach ja Günter ein Beispiel hatte ich zu beginn schon mitgeschickt. (Lbl-test.xlsm)

Zuerst einmal warum Kästchen. Die Checkboxen sind erst einmal zu pipsi (zu klein) und bleiben nicht da wo ich sie positioniere. Ein nervender Wirrwar. Hab schon so vieles ausprobiert und nichts hatte auf Dauer Bestand. Ich Denke dieses Beispiel zeigt es deutlich und das ist mit Checkboxen nicht zu machen.

Und ich brauche auch diese Möglichkeit um den Zustand in einer SQLite Datenbank zu speichern.

Bis jetzt hab ich keine andere Möglichkeit gefunden bei der beides vorhanden ist. Deutliche sichtbare Kästchen und die Möglichkeit den Zustand in einer DB zu speichern.

Wenn Ihr eine bessere Möglichkeit habt dieses zu bewerkstelligen, dann würde ich dieses Prozedere sofort über Bord werfen.

Danke für Eure Antworten, vielleicht wisst Ihr ja wie man es besser machen kann?


Gruß jagga007

[maninweb]

Hallo,

ich habe Dir mal ein Beispiel gemacht, wo anstatt von Steuerelementen Rechtecke verwendet werden.
In der Mappe sind ein paar drin, den Rest musst Du selber anlegen. Am besten durch Kopieren eines
bestehenden Rechtecks und Umbenennen in die Namen wie in der Tabelle Labels. Umbenennen
geht über das Namensfeld. Der Code sieht dann so aus...

Code: Visual Basic

1.   Public Sub ShapesAction()
2.    
3.     Dim c As Long
4.     Dim n As Long
5.    
6.     Dim s As String
7.     Dim v As String
8.    
9.     Dim d As Collection
10.    
11. '   Fehler abschalten...
12.    
13.     On Error Resume Next
14.    
15. '   Collection...
16.    
17.     Set d = New Collection
18.    
19. '   Einlesen der Werte...
20.    
21.     With ThisWorkbook.Worksheets("Labels")
22.    
23.       For n = 2 To 22
24.        
25.         d.Add CStr(n), .Cells(n, 1).Value
26.        
27.       Next
28.    
29.     End With
30.    
31. '   Shape...
32.    
33.     s = Application.Caller
34.     v = ActiveSheet.Shapes(s).TextFrame2.TextRange.Text
35.     c = CLng(CStr(0) & d(s))
36.    
37. '   Check...
38.    
39.     If c > 0 Then
40.    
41.       If Len(v) > 0 Then
42.      
43.         ActiveSheet.Shapes(s).TextFrame2.TextRange.Text = ""
44.         ThisWorkbook.Worksheets("Labels").Cells(c, 2).Value = 0
45.        
46.       Else
47.        
48.         ActiveSheet.Shapes(s).TextFrame2.TextRange.Text = "X"
49.         ThisWorkbook.Worksheets("Labels").Cells(c, 2).Value = 1
50.        
51.       End If
52.      
53.     Else
54.      
55.       MsgBox "Element nicht gefunden."
56.      
57.     End If
58.    
59. '   Collection...
60.    
61.     Set d = Nothing
62.    
63.   End Sub
64.  

Die Collection ist für's Indizieren der Namen und Werte vorhanden. Wie Du siehst, Du brauchst keine
ActiveX-Steuerelemente dazu.

Die Rechtecke kannst Du übrigens so formatieren (Rechtklick), dass deren Position z.B. erhalten bleibt.
Aktuell sind die auf mit Zelle wandern eingestellt, aber Größe behalten.

Wenn die Lösung was für Dich ist, dann entferne komplett den anderen Code (auch in DieseArbeitsmappe).

Gruß

[jagga007]

Hallo Maninweb,

vielen, vielen Dank. eine viel bessere Lösung als die ich hatte. Beziehungsweise weniger ist manchmal mehr.

Aber ganz Nachvollziehen kann ich es nicht. Darum meine Frage.

Ich geh mal davon aus, das Du nur zu Testzwecken die Zeilen aus der Arbeitsmappe in ein Modul kopiert hast, denn Deine Kästchen funktionieren auch ohne dieser Sub Run() da so wie es aussieht alles die Klasse regelt. Sehe ich das richtig?

Ist es sinnvoll, es nicht abzufragen auf welcher Tabelle die Kästchen verwendet werden?

Vielleicht kannst du mir ein bisschen auf die Sprünge helfen.



Gruß jagga007

[maninweb]

Hallo jagga007,

stimmt, die Prozedur Run() im Modul1 war nun zum Testen und kann raus, wie alles andere ausser
ShapesAction(). Auch die Klasse kann weg, da diese nicht mehr verwendet wird. Und der Code in
DieseArbeitsmappe kann ebenfalls weg.

In diesem Fall macht es auch nichts aus, die Tabelle nicht abzufragen, da ein Klick auf ein Kästchen
implizit die aktive Tabelle anspricht. Im Code ist dann ActiveSheet enthalten.

Gruß

[jagga007]

Hallo ManinWeb,

Mann oh Mann das ist ja mal ein spitzen-Code. Vielen Dank für Deine Hilfe, dass es mit so wenig Zeilen zu realisieren ist wauh.


Gruß

[jagga007]

Hallo Maninweb,

würde Dich gerne noch um etwas bitten.

Um die ganzen Shapes im Tabellenblatt auf deaktiviert zu setzen versuchte ich es mit folgenden Codezeilen.

Code: [Auswählen]

Option Explicit

Public Sub TB_zuruecksetzen()
    ausschalten
End Sub

Sub anschalten()
    Ändern True
End Sub

Sub ausschalten()
    Ändern False
End Sub

Public Sub Ändern(an As Boolean)
    On Error Resume Next
    Application.EnableEvents = False
    Dim str$, rng             As Range, i%
    str = IIf(an, "T", VBA.Chr(163))
    i = IIf(an, 0, 1)
    Dim objOLE                As OLEObject

    For Each objOLE In Sheets("Tagesbericht").OLEObjects
        If objOLE.Name Like "LOG*" Then
            objOLE.Object.Caption = str
            Set rng = Sheets("Lbl").Columns(2).Find(objOLE.Name, lookat:=xlWhole)
            If Not rng Is Nothing Then rng.Offset(0, 1) = i
            Set rng = Nothing
        End If
    Next

    Application.EnableEvents = True

End Sub
Bin ich da so weit weg von einer Lösung?

Vielleicht hast Du hier auch noch einen Tipp.


Gruß jagga007

[maninweb]

Hallo,

zuerst denke ich mal, ich hatte nicht richtig verstanden, was Du mit "Deaktivieren" meintest. Ich dachte
zunächst, Du meintest, dass man die nicht mehr anklicken kann. Darauf hin hatte ich Code geschrieben,
der als erstes hier erscheint. Ich lassen den Code hier mal drin und weiter unten ist ein zweiter Code,
der das "X" in den Kästchen setzt oder löscht.

Zu diesem Code hier drunter: Shapes haben eine OnAction-Eigenschaft, wo man festlegen kann, welches
Makro ausgeführt werden soll. Zum Deaktivieren der Funktionalität reicht es somit, das Makro zu löschen
und beim Aktivieren wieder setzen "ShapesAction". ShapesAction ist der Makroname, der bei Rechtsklick,
Makro zuweisen, eingetragen ist.

Code: Visual Basic

1.   Option Explicit
2.  
3.   Public Sub TB_zuruecksetzen()
4.     Ausschalten
5.   End Sub
6.  
7.   Sub Anschalten()
8.     Aendern True
9.   End Sub
10.  
11.   Sub Ausschalten()
12.     Aendern False
13.   End Sub
14.  
15.   Public Sub Aendern(Status As Boolean)
16.    
17.     Dim o As Shape
18.    
19.     For Each o In ThisWorkbook.Worksheets("Tagesbericht").Shapes
20.      
21.       If LCase(o.Name) Like "log*" Then
22.        
23.         o.OnAction = IIf(Status, "ShapesAction", "")
24.        
25.       End If
26.      
27.     Next
28.    
29.   End Sub
30.  

Jetzt ein Code, der wohl das ist, was Du meinst, denke ich mal: alle Kästchen auf "X" setzen oder auf "".

Code: Visual Basic

1.   Option Explicit
2.  
3.   Public Sub TB_zuruecksetzen()
4.     Ausschalten
5.   End Sub
6.  
7.   Sub Anschalten()
8.     Aendern True
9.   End Sub
10.  
11.   Sub Ausschalten()
12.     Aendern False
13.   End Sub
14.  
15.   Public Sub Aendern(Status As Boolean)
16.    
17.     Dim o As Shape
18.    
19. '   Shapes durchlaufen...
20.    
21.     For Each o In ThisWorkbook.Worksheets("Tagesbericht").Shapes
22.      
23.       If LCase(o.Name) Like "log*" Then
24.        
25.         o.TextFrame2.TextRange.Text = IIf(Status, "X", "")
26.        
27.       End If
28.      
29.     Next
30.    
31. '   In einem Rutsch den Bereich setzen...
32.    
33.     ThisWorkbook.Worksheets("Labels") _
34.    .Range("B2:B22").Value = IIf(Status, 1, 0)
35.    
36.   End Sub
37.  

Durchläuft alle Shapes in der Tabelle Tagesbericht und setzt je nach Status ein "X" oder "".
Und setzt die Werte des Bereichs in einem Rutsch. Habe hier den Bereich aus der Mappe genommen,
die ich in einem vorherigen Beitrag gepostet habe.

Noch ein paar Tipps zu Deinem Code: Shapes (also die Rechtecke) sind keine OLEObjekte. Daher liefert Deine
Schleife keine Elemente. Mache mal in Deinem Code MsgBox Sheets("Tagesbericht").OLEObjects.Count und
Du erhälst eine Null. Ausserdem brauchst Du bei Shapes kein Application.EnableEvents, denn bei Shapes
ist Application.EnableEvents wirkungslos. Die Art der Deklaration bei Dir ist jetzt nicht falsch (Dim str$),
dennoch würde ich empfehlen auf die Kurzform zu verzichten. Dim str As String ist besser lesbar,
ebenso eine zeilenweise Deklaration. Last, but least, vermeide Umlaute in Variablennamen und
Prozedurnamen.

Gruß

[jagga007]

Hallo,

Danke für Deine Hilfe und Deinen Tipp. Super!


Gruß jagga007