@snb:
Vergessen zu schreiben:
Mein Blickwinkel zu Edgars Problem war:
Man kann nicht immer den Code des Fragestellers komplett so umbauen, dass er sich gar nicht wiederfindet.
Deshalb habe ich das Coding von Edgar nur thematisch aufgeteilt. Diese einzelnen Schritte kann man später auch einzeln optimieren.
Auch Hallo,
ich finde es brutal, ActiveX-CommandButtons zu nehmen. Hier mal ein Beispiel mit der Autoform Rechteck: (Da könnte man natürlich noch viel mehr formatieren und gestalten.)
Sub test_Kuwer()
Dim loA As Long
Dim loB As Long
Dim lozahl As Long
Dim loZahl2 As Long
Dim loC As Long
Dim CB As Shape
Dim strB As String
Dim strName As String
Dim arrZahlen, arrZahlen2(13)
With Sheets("Tabelle2")
Application.ScreenUpdating = False
.DrawingObjects.Delete
Do
Randomize
loC = Application.WorksheetFunction.RandBetween(1, 61)
If InStr(arrZahlen, loC) = 0 Then
arrZahlen = Format(loC, "00") & "," & arrZahlen 'Zufallszahlen in ein mit Leerzeichen getrennt in ein Array schreiben
arrZahlen2(loB) = loC
loB = loB + 1
End If
Loop While loB < 14
.Cells(1, 2).FormulaLocal = "=INDEX(Liste!1:1;ZUFALLSBEREICH(0;5)*2+1)"
.Cells(1, 2).Value = .Cells(1, 2).Value
For loA = 1 To 61
.Cells(1, 1).FormulaLocal = "=SVERWEIS(ZUFALLSBEREICH(1;200);INDEX(Liste!$1:$1;VERGLEICH($B$1;Liste!$1:$1;0)):INDEX(Liste!$26:$26;VERGLEICH($b$1;Liste!$1:$1;0)+1);2;1)"
strName = .Cells(1, 1)
Set CB = .Shapes.AddShape(msoShapeRectangle, 20, 20, 68.25, 56)
CB.ThreeD.ContourWidth = 0.2
CB.TextFrame2.TextRange.Text = strName
CB.Line.ForeColor.RGB = RGB(192, 192, 192)
CB.Fill.ForeColor.RGB = RGB(192, 192, 192)
CB.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(0, 0, 0)
strB = Format(loA, "00")
If InStr(arrZahlen, strB) <> 0 Then
CB.Fill.ForeColor.RGB = RGB(0, 0, 255)
CB.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
'----------------------
If InStr(arrZahlen, loA) < 27 Then
CB.Fill.ForeColor.RGB = RGB(0, 0, 255)
CB.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = RGB(255, 255, 255)
ElseIf InStr(arrZahlen, loA) < 38 Then
CB.Fill.ForeColor.RGB = RGB(200, 100, 0)
Else
CB.Fill.ForeColor.RGB = RGB(100, 100, 100)
End If
End If
' -------------------------------
If loA < 6 Then
CB.Top = 30
CB.Left = 259 + (loA - 1) * 69
ElseIf loA < 12 Then
CB.Top = 90
CB.Left = 259 + (loA - 6) * 69 - 34
ElseIf loA < 19 Then
CB.Top = 150
CB.Left = 259 + (loA - 13) * 69
ElseIf loA < 27 Then
CB.Top = 210
CB.Left = 259 + (loA - 20) * 69
ElseIf loA < 36 Then
CB.Top = 270
CB.Left = 259 + (loA - 29) * 69
ElseIf loA < 44 Then
CB.Top = 330
CB.Left = 259 + (loA - 37) * 69 - 34
ElseIf loA < 51 Then
CB.Top = 390
CB.Left = 259 + (loA - 45) * 69
ElseIf loA < 57 Then
CB.Top = 450
CB.Left = 259 + (loA - 51) * 68.25 - 34
Else
CB.Top = 510
CB.Left = 259 + (loA - 57) * 68.25
End If
Next
.Range("a1").Clear
.Range("M2") = "Doppelklick hier!"
End With
Application.ScreenUpdating = True
Exit Sub
Fehler: MsgBox (Err.Number & " " & Err.Description & "--> Button " & loA & " " & strName & " " & arrZahlen)
End Sub
Gruß Uwe
@DBsam
Mien Beispiel läuft hier makellos.
Was hast du verpasst ?? ;)
@snb:
Hhmm, weiß nicht. Wahrscheinlich falsch gehandhabt.
Ich habe es jetzt noch einmal herunter geladen und lokal abgespeichert.
Nun läuft es und da macht die Ansicht Deines Code wieder Spaß. Danke.
Ich guck ...
Gruß Carsten
@Kuwer:
Oooch, brutal - Das klingt so brutal ... :D
Eigentlich haben wir uns aktuell dem eigentlichen Problem so langsam genähert:
- Vermeidung von Löschung und Neuerstellung von was auch immer. Seien es nun brutale Buttons, Rechtecke, Bilder oder sonstwas.
- Vermeidung der Vermischung von 'VBA-Gehampel' mit 'Formelgehampel'
- Optimierung, bzw. bessere Kontrolle bei der Generierung der Anzahl der farbigen 'WasAuchImmers'.
So jedenfalls mein derzeitiger Kenntnisstand.
Gruß Carsten
Hi Uwe,
das ist mal ein Wort. Das läuft ja in Nullkommanichts ab. :23:
Habe ich so übernommen. Danke.
Ok.
Wie geht es weiter?
Edit:
Alle aufgeführten Fehler sind noch enthalten.
Hi,
ich habe den Code von Uwe übernommen und noch ein paar Kleinigkeiten bereinigt. Für mich ist das jetzt erst einmal die endgültige Version, die wohl auch so zum Einsatz kommt. Mit der Variante von snb muß ich mich auseinandersetzen, wenn ich Zeit habe, was noch ein paar Tage dauern kann (Fasnacht).
Gut, dann lege ich mich wieder hin. :D
Gruß Carsten
PS:
Was noch zu erledigen ist:
- Es werden immer noch unnötig Shapes erstellt, anstatt nur deren Eigenschaften zu verändern
- Die Ermittlung und Zuweisung der Farben funktioniert nicht zuverlässig. (Teste mal mehrmals ...)
(Deswegen würde ich solche Dinge auslagern und extra behandeln.)
- Es gibt immer noch ein Vermischung von Formeln und VBA-Gehampel
- Unnötige Variablen und Zuweisungen müssen noch entfernt werden
Hi Carsten,
die Zuweisung der Farben passt mit diesem Code:
Code:
InStr(arrZahlen, Format(loA, "00"))
der Rest ist momentan nicht so dringend, es geht momentan nur darum, uns die Gestaltung des Spielplans zu vereinfachen. Da das Spiel mehrere Stunden dauert, wird es maximal zweimal am Abend und ggf. dreimal an einem Sonntag gespielt, d.h. die Datei läuft ca. 7x pro Woche :19: