With a smile

[snb]

Obwohl ich die Mehrheit der Helfer zustimme dass es wohl sehr viel Einwand gibt Noteneinträge zu 'verschlimmbesseren' mittels Smilies, habe ich mal probiert etwas zu 'basteln' (d'r Bastler), das veilleicht mit Maus genau so schnell geht als mit dem Tastatur.
Ich fürchte dass unser beliebter TS kaum versteht was in VBA passiert. Etwas anpassen scheint mir ganz unmöglich mit seiner freche Haltung.
Dieser Vorschlag darum nur für Interessierte.
Selektiere eine Zelle die befüllt werden muss und schau mal was passiert.

[DIZA]

Hallo snb,

cool gemacht. Ich fürchte jedoch, das der TS nicht die Notenwerte in der Tabelle haben wollte, sondern die Smilies.

[snb]

Scheint mir auch kein Problem (für VBA, doch wohl für den Beobachter)

[derHoepp]

Moin,

ich hab da auch noch eine Kleinigkeit vorbereitet. Natürlich hab ich dabei die Kreuztabellenerfassung in eine Listenerfassung umgeändert. Es wird für jeden Schüler aus einer Stammdatentabelle tbSchülerInnen die Note des Tages abgefragt und in ein Listobject "tbEinzelnoten" eingetragen. Dort gibt es die Felder ID, SchülerID_F, NotenID_F, Datum und ein An- / Abwesenheitskennzeichen. Diese ListObjecte sind zusammen mit einem dritten ListObject "tbNotenstufen" Teil des PowerPivot-Datenmodells und lassen sich damit sehr einfach nach Lust und Laune auswerten. An- und Abwesenheiten lassen sich somit individuell gewichten.

Prinzipiell genügt die Tastatur als Benutzerschnittstelle, wenn man die benötigten Daten einfach untereinander einträgt.

Aber natürlich funktioniert auch jede andere Benutzerschnittstelle, die in der Lage ist, aus mehreren Optionen eine auszuwählen (Interface-Programmierung hooray!). Vorstellbar wäre eine Auswahlklasse mit einer Methode getIndexOfChoiceByCaption(Prompt As Variant, Captions As Variant). Captions soll dabei ein Array sein, welches Beschriftungen oder ähnliches enthält. Wie der Name verrät, ist das Ziel der Methode, den Index der Auswahl zurückzugeben.
Als konkrete Implementationen sind vielfältige Möglichkeiten denkbar. Von einer Klasse, die als Zufallsgenerator die Noten würfelt, über eine einfache Listbox, ein auszufüllendes Wordformular, heuristischen Ableitungen aus Tabellenblättern bis eben auch zu einer UserForm, die klickbare Objekte anbietet, die beispielsweise einen Smilie tragen sind der Phantasie wenige Grenzen gesetzt (genau das ist für mich interessant am konkreten Problem, wie lässt sich das ganze so offen gestalten, dass das gewünschte UI nur eine mögliche Lösung ist).

Umgesetzt habe ich (ähnlich wie snb) eine UserFormklasse, die Buttons anzeigen kann, die bei einem Klick ein Ergebnis zurückgeben. Dabei werden die Buttons allerdings zur Laufzeit erzeugt (das ist etwas, dass snb wohl eher als aufgabe zur Design-Zeit sehen würde). Die Kommunikation zwischen dynamischem CommandButton und UserForm-Klasse übernimmt dabei eine Event-Routing-Klasse. Die Userformklasse gibt dann den Index aus dem übergebenen Array zurück, dessen Element gewählt wurde. Der Klasse ist es dabei egal, ob ihr Notenstufen mit Smilies als Caption übergeben werden, oder Buchstaben oder beliebige Unicodezeichen. Sie lässt sich also auch für jedes andere Projekt verwenden, bei denen der Nutzer eine Auswahl treffen muss. Zur Hilfe gibt es noch ein Label, mit dem ein Prompt angezeigt werden kann.

Die Aufgabe des Hauptprogramms ist es dann nur noch, alle Schüler durchzugehen, die UserFormKlasse mit den Notenstufen aufzurufen und das Ergebnis in das ListObject zu schreiben.

Lange Rede mit kurzem Sinn, damit die Klicks dynamisch erstellter CommandButtons verarbeitet werden können, benötigt es eine eigene Klasse, die die CommandButtonObjekte kontrolliert. Ich habe Sie AdvancedButton genannt. Zusätzlich verwaltet diese Klasse auch noch den Index aus dem Array:

Code:

Option Explicit
'ClassName: AdvancedButton

Private WithEvents mCMD As CommandButton
Private mIndex As Long
Private mEventRouter As AdvancedButtonEventRouter

Public Property Get Index() As Long
    Index = mIndex
End Property

Public Property Get Caption() As String
    Caption = mCMD.Caption
End Property

Public Sub SetButton(cmdBut As CommandButton, EventRouter As AdvancedButtonEventRouter, Index As Long)
    Set mCMD = cmdBut
    Set mEventRouter = EventRouter
    mIndex = Index
End Sub

Private Sub mCMD_Click()
    mEventRouter.DoRaiseClick Me
End Sub

Die Kommunikation mit der "Mutter-UserForm" geschieht über die Klasse AdvancedButtonEventRouter:

Code:

Option Explicit
'ClassName: AdvancedButtonEventRouter

Public Event Click(advBut As AdvancedButton)

Public Sub DoRaiseClick(advBut As AdvancedButton)
    RaiseEvent Click(advBut)
End Sub

Das Click-Event dieser Klasse wird dann in der UserFormKlasse verarbeitet. Die UserFormKlasse bietet nach außen die besagte getIndexOfChoiceByCaption(Prompt As Variant, Captions As Variant)-Methode an. Im Designmodus benötigt diese nur ein Label1-Steuerelement, welches später den Prompt anzeigt und unter dem die Buttons eingefügt werden:

Code:

Option Explicit
'ClassName: ButtonChoiceBox
'UserForm
'Controls: Label1: Displaying Prompt

Private WithEvents mEventRouter As AdvancedButtonEventRouter
Private mAdvancedButtons As Collection
Private mRetIndex As Variant
Private mRetCaption As Variant

Public Function getIndexOfChoiceByCaption(Prompt As Variant, Captions As Variant)
    Set mAdvancedButtons = New Collection
    mRetIndex = -1
    mRetCaption = -1
   
    Label1.Caption = Prompt
    Dim tmpBtn As CommandButton
    Dim tmpAdvancedButton As AdvancedButton
    Dim btnWidth As Double
    Const SPACING = 3
    btnWidth = (Me.Width / (UBound(Captions) - LBound(Captions) + 1)) - SPACING
   
    Dim i As Long
    For i = LBound(Captions) To UBound(Captions)
        Set tmpBtn = Me.Controls.Add("Forms.CommandButton.1")
        tmpBtn.Top = Label1.Top + 20
        tmpBtn.Width = btnWidth
        tmpBtn.Left = (i - LBound(Captions)) * (btnWidth + SPACING)
        tmpBtn.Caption = Captions(i)
        Set tmpAdvancedButton = New AdvancedButton
        tmpAdvancedButton.SetButton tmpBtn, mEventRouter, i
        mAdvancedButtons.Add tmpAdvancedButton
    Next i
    Me.Show
    getIndexOfChoiceByCaption = mRetIndex
End Function

Private Sub mEventRouter_Click(advBut As AdvancedButton)
    mRetIndex = advBut.Index
    mRetCaption = advBut.Caption
    Me.Hide
End Sub

Private Sub UserForm_Initialize()
    Set mEventRouter = New AdvancedButtonEventRouter
End Sub

Private Sub UserForm_QueryClose(Cancel As Integer, CloseMode As Integer)
    Cancel = True
    Me.Hide
End Sub

Die Klasse ist soweit vorbereitet, dass eine getChoice()-Methode sehr einfach implementiert werden könnte, in dem die Caption als ReturnValue verwendet wird.

Fehlt nur noch ein Programm, was die ganzen Fäden zusammenbringt. Wenn es die in der Einleitung genannten ListObjects gibt (die in den Worksheets liegen, wie im Code ersichtlich), fragt das folgende Programm für jeden Schüler nach einer Auswahl aus Unicodezeichen (die im konkreten Fall Smilies sind):

Code:

Option Explicit

Sub test1()
    Dim BCBOx As New ButtonChoiceBox
   
    Dim NotenStufen As ListObject
    Dim SchuelerInnen As ListObject
    Dim EinzelNoten As ListObject
    Set NotenStufen = Worksheets("Stammdaten").ListObjects("tbNotenStufen")
    Set SchuelerInnen = Worksheets("Stammdaten").ListObjects("tbSchülerInnen")
    Set EinzelNoten = Worksheets("Benotungen").ListObjects("tbEinzelNoten")
   
    Dim lrSchueler As ListRow
    Dim NotenZeichen As Variant
    Dim NotenIDs As Variant
    NotenZeichen = WorksheetFunction.Transpose(Intersect(NotenStufen.DataBodyRange, NotenStufen.ListColumns("UnicodeZeichen").Range))
    NotenIDs = WorksheetFunction.Transpose(Intersect(NotenStufen.DataBodyRange, NotenStufen.ListColumns("NotenID").Range))
    For Each lrSchueler In SchuelerInnen.ListRows
        Dim tmpIndex As Variant
        Dim Prompt As String
        Prompt = Intersect(SchuelerInnen.ListColumns("Nachname").DataBodyRange, lrSchueler.Range).Text & ", " & Intersect(SchuelerInnen.ListColumns("Vorname").DataBodyRange, lrSchueler.Range).Text
        tmpIndex = BCBOx.getIndexOfChoiceByCaption(Prompt, NotenZeichen)
        Dim NeueNotenzeile As ListRow
        Set NeueNotenzeile = EinzelNoten.ListRows.Add
       
        With NeueNotenzeile
            Intersect(.Range, EinzelNoten.ListColumns("SchülerID_F").Range) = Intersect(lrSchueler.Range, SchuelerInnen.ListColumns("SchülerID").Range)
            Intersect(.Range, EinzelNoten.ListColumns("Datum").Range) = Date
            If tmpIndex <> -1 Then
                Intersect(.Range, EinzelNoten.ListColumns("NotenID_F").Range) = NotenIDs(tmpIndex)
                Intersect(.Range, EinzelNoten.ListColumns("Teilnahme").Range) = "Anwesend"
            Else
                Intersect(.Range, EinzelNoten.ListColumns("Teilnahme").Range) = "Abwesend"
            End If
        End With
    Next lrSchueler
   
End Sub

Viele Grüße
derHöpp