PDA

Vollständige Version anzeigen : Schaltflächen duplizieren


Stefan5
25.08.2017, 13:35
Hallo VBA-cracks,

ich bin Lehrer und beschäftige mich seit einigen Tagen damit, eine automatisierte Erfassung in EXCEL von vergessenen Hausaufgaben und der Mitarbeit meiner Schüler zu programmieren.
Zunächst habe ich schnell Fortschritte gemacht, doch bei meiner Mitarbeitsliste komme ich mit meinen VBA Kenntnissen nicht weiter.

Ich habe zunächst ein Makro erstellt, das aus einem Tabellenblatt "HA-Vergessensliste" die Namen der Schüler ausliest und in einem anderen Tabellenblatt ("HA-Sitzplan") einen provisorischen Sitzplan erstellt, der aus Formularsteuerelementen besteht (Siehe angehängter Code).
Durch Anklicken dieser Buttons wird das Datum in der Vergessensliste festgehalten (Spalte C: Nachname, B: Vorname, E: Anzahl der verg. HA, ab F: automatische Datumseintragungen)
Die Anordnung der Schüler im Tabellenblatt "HA-Sitzplan" geschieht zunächst durch das Makro alphabetisch und wird dann "händisch" (d.h. über den Entwurfsmodus) an die tatsächlichen Gegebenheiten angepasst.

Bis hierhin funktioniert alles wie gewünscht.

Nun möchte ich auch noch einen "Mitarbeits-Sitzplan" ergänzen, bei dem jeder Schüler mit zwei Buttons (Gut / Schlecht) verknüpft ist und die Klicks ebenfalls in einem Tabellenblatt protokolliert werden.

Dazu möchte ich den schon an die tatsächlichen Gegebenheiten angepassten "HA-Sitzplan" nützen, d.h. die Positionen der einzelnen Steuerelemente abfragen und automatisch den entsprechenden "Mitarbeits-Sitzplan" generieren.

Hier scheitere ich aber mangels solider VBA Kenntnisse und werde auch durch intensives Googeln nicht schlauer.

Wenn mir jemand über diese Klippe helfen könnte, wäre ich sehr dankbar!

Hier der bisher erstellte Code (und im Anhang die komplette Datei):



Declare Function GetSystemMetrics Lib "user32" (ByVal nIndex As Long) As Long
Public Const summenspalte = 5
Public Schülerzahl As Integer

Sub Schaltfläche_Klicken(ByVal Schueler As Integer)

Worksheets("HA-Vergessensliste").Activate
Dim spalte As Integer, zeile As Integer

zeile = Schueler + 1
ActiveSheet.Cells(zeile, summenspalte).Value = ActiveSheet.Cells(zeile, summenspalte).Value + 1
spalte = ActiveSheet.Cells(zeile, summenspalte).Value + summenspalte
ActiveSheet.Cells(zeile, spalte).FormulaLocal = Date
If Cells(zeile, summenspalte).Value Mod 3 = 0 Then
MsgBox Cells(zeile, summenspalte - 1).Value & " hat zum " & Cells(zeile, summenspalte).Value & ". mal die HA vergessen!", _
vbInformation, "Nacharbeit fällig"
End If
Worksheets("HA-Sitzplan").Activate
End Sub

Sub Initialisieren()
Dim i As Integer, Sitzreihen As Integer, Sitzspalten As Integer, Bankbreite As Integer, Z As Integer, S As Integer
Dim gWidth As Integer, gHeight As Integer
Dim HASchüler As Object

Worksheets("HA-Sitzplan").Activate
gWidth = GetSystemMetrics(0)
gHeight = GetSystemMetrics(1)
For Each HASchüler In Worksheets("HA-Sitzplan").Buttons
If HASchüler.Caption <> "Initialisieren" Then HASchüler.Delete
Next HASchüler
Schülerzahl = 1
Do While Worksheets("HA-Vergessensliste").Cells(Schülerzahl + 1, summenspalte - 1).Value <> ""
Schülerzahl = Schülerzahl + 1
Loop
Schülerzahl = Schülerzahl - 1
Sitzreihen = Application.InputBox("Zahl der Sitzreihen (Schüler hintereinander):", "Sitzreihen eingeben", 6)
Sitzspalten = Application.InputBox("Zahl der Sitzspalten (Schüler nebeneinander):", "Sitzspalten eingeben", 6)
Bankbreite = Application.InputBox("Zahl der Schüler pro Bank:", "Bankbreite eingeben", 2)
Range("A:Z").EntireColumn.ColumnWidth = Int(gWidth / (5 * Sitzspalten + 2))
Range("3:40").EntireRow.RowHeight = Int(0.8 * gHeight / (Sitzreihen))

For i = 1 To Schülerzahl
Z = ((i - 1) Mod Sitzreihen) + 3
S = Application.RoundUp(i / Sitzreihen, 0)
S = S - 1 + Application.RoundUp(S / Bankbreite, 0)

Set HASchüler = Worksheets("HA-Sitzplan").Buttons.Add(Cells(Z, S).Left, Cells(Z, S).Top, _
Int(gWidth / (Sitzspalten)), Int(0.8 * gHeight / (Sitzreihen)))
HASchüler.OnAction = "'Schaltfläche_Klicken""" & i & "'"
HASchüler.Caption = Worksheets("HA-Vergessensliste").Cells(i + 1, summenspalte - 1) & Chr(10) & _
Worksheets("HA-Vergessensliste").Cells(i + 1, summenspalte - 2)
HASchüler.Select
With Selection.Font
.Name = "Calibri"
.FontStyle = "Standard"
.Size = 28
.ColorIndex = 1
End With
Next
End Sub

Sub Rückgängig(ByVal Schüler As Integer)
If Cells(Schüler + 1, summenspalte).Value > 0 Then
Cells(Schüler + 1, summenspalte).Value = Cells(Schüler + 1, summenspalte).Value - 1
Cells(Schüler + 1, summenspalte + Cells(Schüler + 1, summenspalte).Value + 1).Delete
End If
End Sub

Sub Liste_zurücksetzen()
Dim i As Integer, Korr As Object
i = MsgBox("Alle Daten löschen?", 1 + vbQuestion, "Zurücksetzen")
If i = 2 Then Exit Sub

Schülerzahl = 1
Do While Worksheets("HA-Vergessensliste").Cells(Schülerzahl + 1, summenspalte - 1).Value <> ""
Schülerzahl = Schülerzahl + 1
Loop
Schülerzahl = Schülerzahl - 1

Range(Cells(2, summenspalte + 1), Cells(Schülerzahl + 1, summenspalte + 12)).Select
Selection.Clear
For i = 2 To Schülerzahl + 1
Cells(i, summenspalte).Value = 0
Next

For Each Korr In Worksheets("HA-Vergessensliste").Buttons
If Korr.Caption <> "Zurücksetzen" Then Korr.Delete
Next Korr

For i = 1 To Schülerzahl
Set Korr = Worksheets("HA-Vergessensliste").Buttons.Add(Cells(i + 1, 1).Left, Cells(i + 1, 1).Top, 5 * Cells(i + 1, 1).ColumnWidth, _
Cells(i + 1, 1).RowHeight)
Korr.OnAction = "'Rückgängig""" & i & "'"
Korr.Caption = "<-"
Korr.Font.Size = 18
Next
End Sub