VBA Backcolor in CommandButton führt zu Fehlern

[DbSam]

Hallo Edgar,

danke für die Rückmeldung und Erklärung.

Ich bekomme das Coding von snb so schnell nicht zum laufen, da muss man wieder erst alles umbauen und deklarieren.
Probiere ich dann später noch einmal.

Der umgebaute Code von mir sollte aber bei Dir unbedingt funktionieren, denn dieser läuft bei mir in der von Dir oben geposteten Datei ohne Probleme durch. Und nochmal und nochmal und nochmal ...
Der entspricht genau Deinem Coding, nur etwas 'thematisch' getrennt. 

Wenn das also ein wirkliches Projekt ist, dann würde ich eher objektorientiert vorgehen und eine Klasse dafür erstellen.
(Array geht zwar auch, ist aber aus meiner Sicht später nicht mehr so schön lesbar/änderbar/erweiterbar.)
Dann zuerst die Eigenschaften aller Buttons ermitteln/festlegen und in der Collection wegschreiben.
Zum Schluss in einem Rutsch die Button löschen und neu erstellen.
Der Vorteil wäre, dass alles lesbar ist der Code bis zum löschen und neu erstellen debugbar bleibt.




Gruß Carsten

[BoskoBiati]

Hi Carsten,

ich habe es auf einem anderen Rechner laufen lassen, funktioniert. Was in Einzelfällen passiert ist, dass statt 9 auf einmal 10 blaue Felder erstellt werden, warum konnte ich noch nicht nachvollziehen.

Fehler gefunden:

Code:

Select Case InStr(myValues, Format(i, "00"))

Wenn das also ein wirkliches Projekt ist, dann würde ich eher objektorientiert vorgehen und eine Klasse dafür erstellen.

Das übersteigt meine eher Anfängerkenntnisse.

[snb]

Da konnte noch etwas verbessert werden:

Code:

Private Sub worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
  If Target.Address <> "$M$2" Then Exit Sub
  cancel = True
    
  With Tabelle1
    If .Shapes.Count = 0 Then
      For j = 0 To 59
        With .OLEObjects.Add("Forms.CommandButton.1")
          .Name = "C_" & Format(jj, "00")
          .Height = 60
          .Width = 68.25
          .Top = 30 + .Height * (j \ 6)
          .Left = 259 + (j Mod 6) * (.Width + 0.75)
          Tabelle1.Cells(1) = .Object.BackColor
        End With
      Next
    End If
         
    sn = Tabelle2.Cells(1).CurrentRegion
    y = Abs(Int(6 * Rnd() - 0.01)) + 1
    For j = 1 To UBound(sn)
      If sn(j, y) = "" Then Exit For
    Next
         
    For jj = 0 To 59
      With .OLEObjects("C_" & Format(jj, "00")).Object
        .Caption = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)
        .BackColor = RGB(200, 200, 200)
        .ForeColor = RGB(0, 0, 0)
      End With
    Next
         
    .[K1:K60] = "=rand()"
    sp = [index(rank(T_OLE!K1:K60,T_OLE!K1:K60)-1,)]
    .[K1:K60].ClearContents
         
    For j = 1 To 14
      With .OLEObjects("C_" & Format(sp(j, 1), "00")).Object
        .BackColor = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
        If sp(j, 1) < 27 Then .ForeColor = RGB(255, 255, 255)
      End With
    Next
  End With
End Sub

[DbSam]

... und auch manchmal elf.

Eben nochmal geschaut:
Dies wird ja auch nirgendwo begrenzt. Es werden derzeit 14 Zufallszahlen zwischen 1 und 61 erzeugt.
Rein theoretisch könnte es im Moment auch 14 blaue geben, wenn alle 14 Zufallszahlen kleiner 27 sind.

Wenn man Deine Bedingungen kennen würde, dann könnte man die Erzeugung der Zufallszahlen auch etwas besser angehen.
Zum Beispiel könnte man prüfen, dass es nur maximal 9 Zahlen kleiner als 27 geben darf. Oder was auch immer

Ansonsten ist mir ein Fehler bei meinen Änderungen aufgefallen:
Bitte ersetze in der Sub CreateMyButton die Zeile Case 28 To 38 durch Case 27 To 37.
Dies entspricht Deinem ersten Coding, ändert aber am eben angesprochenem Problem nichts.




Gruß Carsten

[DbSam]

Fehler gefunden:

Code:

Select Case InStr(myValues, Format(i, "00"))

Ja, stimmt. Da habe ich verschlimmbessert.
Richtig wäre:

Code:

Select Case i

Frage:
Gibt es eine weitere Regel für die Anzahl der farbigen Button?





@snb:
Habe deine Datei angeschaut, interessantes Coding wie immer. ;)
Aber leider immer mit Laufzeitfehler 1004-Element nicht gefunden und falscher Aufbau.


Gruß Carsten

[BoskoBiati]

Hi,

die Beschränkung ist da. Mit Instr wird ja nur die Stelle gesucht, an der die Zahl im Array steht. Es wird als der CB mit der aktuellen Nummer gefärbt, wenn diese im Array vorkommt. Problem war, dass Zahlen kleiner 10 durchaus in größeren Zahlen weiter vorne gefunden wurden. Die Änderung des Vergleichs hat das gelöst.
Das mit Case 27 hattee ich schon geändert.
Mit Split könnte man evtl. das Array aufdröseln und die CB´s direkt ansprechen. In meinem Originalcode war das das Array arrZahlen2().

Regeln für die Farben: 9 blaue u. 4 braune Felder sowie 1 graues Feld

[DbSam]

Nochmal nachgeschaut:
Mit dem arrZahlen2() hast Du aber nichts gemacht. Es wurde gefüllt und war dann nur noch 'sinnlos' vorhanden. Es wurde nie abgefragt, deshalb habe ich es entfernt.

Ok, könntest Du mal bitte Deinen aktuellen Code posten, damit wir auf der gleichen Basis sind?

Zu Deiner Bemerkung mit Deinen Kenntnissen:
Wenn Du möchtest, dass ich Dir eine kleine Vorgabe erstelle, dann solltest Du diese problemlos verstehen und erweitern können.
Vermute ich mal so ...

Einschränkung vorweg, obwohl interessant:
Ich habe aber heute nicht mehr sehr viel Zeit, erst am späten Abend wieder.



Gruß Carsten

[snb]

Es geht primär um die Programmierungvorstöße; nich um Exakte 'Lösung'.

- analyse von Programmierstufen
- 'richtige' bau der Code
- Vermeidung verbundener Zellen
- Minimierung der Arbeitsblattinteraktion (keine ExcelFormeln wo VBA reicht)

Man sollte fähig sein die Code nur ein wenig an zu passen an den exakte Bedingungen/Wünsche (wie lernt man anders ??).
Es scheint mir etwas aufwändig/doof immer die Oleobjects neu zu gestalten wenn die immer in identischen Stellen stehen sollten.
DoppelKlicke mal verschiedene Male in M2

Noch etwas näher zur 'Lösung':

Code:

Private Sub worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    If Target.Address <> "$M$2" Then Exit Sub
    cancel = True
    
    With Tabelle1
         If .Shapes.Count = 0 Then
            sn = Array(0, 5, 11, 18, 26, 35, 43, 50, 56, 61, 70)
            For j = 0 To 60
                 y = Application.Match(j, sn, 1) - 1
                 With .OLEObjects.Add("Forms.CommandButton.1")
                    .Name = "C_" & Format(j, "00")
                    .Height = 60
                    .Width = 68.25
                    .Top = 30 + .Height * y
                    .Left = 259 - IIf(y < 5, y, 8 - y) * (.Width + 0.75) / 2 + (j - sn(y)) * (.Width + 0.75)
                End With
            Next
         End If
         
        sn = Tabelle2.Cells(1).CurrentRegion
        y = Abs(Int(6 * Rnd() - 0.01)) + 1
        For j = 1 To UBound(sn)
          If sn(j, y) = "" Then Exit For
        Next
         
         For jj = 0 To 60
             With .OLEObjects("C_" & Format(jj, "00")).Object
                 .Caption = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)
                 .BackColor = RGB(200, 200, 200)
                .ForeColor = RGB(0, 0, 0)
              End With
         Next
         
        .[K1:K61] = "=rand()"
        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
        .[K1:K61].ClearContents
         
         For j = 1 To 14
            With .OLEObjects("C_" & Format(sp(j, 1), "00")).Object
                .BackColor = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
                 If sp(j, 1) < 27 Then .ForeColor = RGB(255, 255, 255)
             End With
         Next
     End With
End Sub

[BoskoBiati]

Hi Carsten,

Du hast recht. Das stammte aus einem vorhergehenden Code, bei dem ich anders vorgegangen bin.

Aktuell sieht mein Code so aus:

Code:

Sub test()
  Dim loA As Long
  Dim loB As Long
  Dim lozahl As Long
  Dim loZahl2 As Long
  Dim loC As Long
  Dim CB(61)
  Dim strB As String
  Dim strName As String
  Dim arrZahlen, arrZahlen2(13)
With Sheets("Tabelle2")
On Error Resume Next
  Application.ScreenUpdating = False
  .Shapes.SelectAll
  Selection.Delete
  On Error GoTo Fehler
      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(loA) = .OLEObjects.Add("Forms.CommandButton.1") 'Button einfügen
      CB(loA).Object.Caption = strName
      CB(loA).Height = 60
      CB(loA).Width = 68.25
      strB = Format(loA, "00")
     
      If InStr(arrZahlen, strB) <> 0 Then
'----------------------
          If InStr(arrZahlen, Format(loA, "00")) < 26 Then
              CB(loA).Object.BackColor = RGB(0, 0, 255)
              CB(loA).Object.ForeColor = RGB(255, 255, 255)
          ElseIf InStr(arrZahlen, Format(loA, "00")) < 38 And InStr(arrZahlen, loA) > 27 Then
              CB(loA).Object.BackColor = RGB(200, 100, 0)
          Else
              CB(loA).Object.BackColor = RGB(100, 100, 100)
          End If
      End If
' -------------------------------
     
      If loA < 6 Then
         
          CB(loA).Top = 30
          CB(loA).Left = 259 + (loA - 1) * 69
      ElseIf loA < 12 Then
          CB(loA).Top = 90
          CB(loA).Left = 259 + (loA - 6) * 69 - 34
      ElseIf loA < 19 Then
          CB(loA).Top = 150
          CB(loA).Left = 259 + (loA - 13) * 69
      ElseIf loA < 27 Then
          CB(loA).Top = 210
          CB(loA).Left = 259 + (loA - 20) * 69
      ElseIf loA < 36 Then
          CB(loA).Top = 270
          CB(loA).Left = 259 + (loA - 29) * 69
      ElseIf loA < 44 Then
          CB(loA).Top = 330
          CB(loA).Left = 259 + (loA - 37) * 69 - 34
      ElseIf loA < 51 Then
          CB(loA).Top = 390
          CB(loA).Left = 259 + (loA - 45) * 69
      ElseIf loA < 57 Then
          CB(loA).Top = 450
          CB(loA).Left = 259 + (loA - 51) * 68.25 - 34
      Else
          CB(loA).Top = 510
          CB(loA).Left = 259 + (loA - 57) * 68.25
      End If
  Next
   .Range("a1").Clear
   .Range("B2") = "Doppelklick hier!"
End With

Application.ScreenUpdating = True
Exit Sub
Fehler: MsgBox (Err.Number & "   " & Err.Description & "--> Button " & loA & " " & strName & " " & arrZahlen)
End Sub

Und bei Deinen habe ich die beiden bearbeitet:

Code:

Private Function CreateMyValues() As String
On Error GoTo Er
   Dim i As Integer
   Dim loC As Long
   Dim myValues As String
   
   Do
       Randomize
       loC = Application.WorksheetFunction.RandBetween(1, 61)
       If InStr(myValues, loC) = 0 Then
           myValues = Format(loC, "00") & "," & myValues
           i = i + 1
       End If
   Loop While i < 14
   
   CreateMyValues = myValues
   
Ex:
   Exit Function
Er:
   MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "Sub CreateMyValues"
   Resume Ex
End Function
Private Sub CreateMyButton(ByVal sh As Worksheet, ByVal strCaption As String, ByVal myValues As String, ByVal i As Integer)
On Error GoTo Er
   Dim o As Object
   
   Set o = sh.OLEObjects.Add(ClassType:="Forms.Commandbutton.1", Width:=68.25, Height:=60)
   If o Is Nothing Then Exit Sub
   With o
       .Object.Caption = strCaption
       If InStr(myValues, Format(i, "00")) <> 0 Then
       
           Select Case InStr(myValues, Format(i, "00"))
           
               Case Is < 27
                   .Object.BackColor = RGB(0, 0, 255)
                   .Object.ForeColor = RGB(255, 255, 255)
               Case 27 To 38
                   .Object.BackColor = RGB(200, 100, 0)
               Case Else
                   .Object.BackColor = RGB(100, 100, 100)
           End Select
       End If
   End With
   ArrangeMyObject o, i
   
Ex:
   Set o = Nothing
   Exit Sub
Er:
   MsgBox Err.Number & vbNewLine & Err.Description, vbCritical, "Sub CreateMyButton"
   Resume Ex
End Sub

Was meine Kenntnisse betrifft, mit Klassen kann ich nichts anfangen, ansonsten verstehe ich Deine Codes und auch die von snb, ich bin auch in der Lage diese abzuwandeln.
Theoretisch habe ich heute auch kaum Zeit noch was zu machen.

[DbSam]

@snb:

Ja, mit dem aktuellen Hintergrundwissen von Edgars Problem: Man muss diese nicht immer neu erstellen.
Im Gegenteil, wenn diese einen eindeutigen Name besitzen, dann kann man diese gezielt ansprechen und dann deren Eigenschaften anpassen. Und fertig.

Wie immer in einem solchen Forum bekommt man aber als Helfender alle Details erst nach und nach zur Kenntnis.
Manche Lösungsvorschläge sind daher manchmal zuerst suboptimal.
Zumal hier die Frage nach dem Fehler beim Erstellen der Buttons lag. Das lockt einen, zumindest mich diesmal, auf die falsche Spur.

Zu Deinem Beispiel:
Ich bin bis gerade eben davon ausgegangen, dass eine hochgeladene Beispielmappe auch funktioniert. Sonst wäre diese kein Beispiel. ;)
Wenn diese aber gewollt nicht funktioniert und 'nur' zur Veranschaulichung des Weges dient, dann schau ich mir Deinen Code sehr gern mit diesem Blickwinkel genauer an. :)

@boskobiati:
Danke für den aktuellen Stand, dann machen wir bis heute Abend halt erst einmal eine Pause.


Gruß Carsten