VBA Backcolor in CommandButton führt zu Fehlern

[snb]

Nicht nötig ;)
Es geht so:

Code:

Sub M_snb()
   If Tabelle1.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 Tabelle1.Shapes
                c00 = "C_" & Format(j, "00")
                With .AddShape(10, 259 - IIf(y < 5, y, 8 - y) * 69 / 2 + (j - sn(y)) * 69, 30 + y * 60, 68.25, 0.885 * 68.25)
                  .Name = c00
                  .Rotation = 27
                  .LockAspectRatio = True
                End With
                With .AddLabel(1, Tabelle1.Shapes(c00).Left + 6, Tabelle1.Shapes(c00).Top + 15, 58, 33).TextFrame
                    .Parent.Name = "T_" & Format(j, "00")
                    .AutoSize = False
                    .MarginLeft = 4
                    .MarginRight = 0
                    .MarginBottom = 0
                    .MarginTop = 0
                    .VerticalAlignment = -4108
                    .HorizontalAlignment = -4108
                    .Characters.Font.Color = RGB(0, 0, 0)
                End With
            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
        Tabelle1.Shapes("C_" & Format(jj, "00")).Fill.ForeColor.RGB = RGB(200, 200, 200)
        With Tabelle1.Shapes("T_" & Format(jj, "00")).TextFrame.Characters
           .Text = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)
           .Font.Color = RGB(0, 0, 0)
         End With
    Next
    
   With Tabelle1
       .[K1:K61] = "=rand()"
        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
       .[K1:K61].ClearContents
    End With
    
    For j = 1 To 14
       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
    Next
End Sub

[BoskoBiati]

Hi,

Klasse, nur die bunten Felder haben nicht gepasst. Das habe ich angepasst:

Code:

Private Sub worksheet_BeforeDoubleClick(ByVal Target As Range, cancel As Boolean)
    Dim sn
    Dim j As Long
    Dim y As Long
    Dim c00 As String
    Dim jj As Long
    Dim loC As Long
    Dim loB As Long
    Dim arrzahlen
    Dim arrzahlen2
    Dim sp
    If Target.Address <> "$M$2" Then Exit Sub
    cancel = True
    Tabelle1.DrawingObjects.Delete
   If Tabelle1.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 Tabelle1.Shapes
                c00 = "C_" & Format(j, "00")
                With .AddShape(10, 259 + IIf(y < 5, 0, 8 + (y - 6) * 5) - IIf(y < 5, y, 8 - y) * 55 / 2 + (j - sn(y)) * 63, 30 + y * 53, 70, 0.885 * 69)
                  .Name = c00
                  .Rotation = 27
                  .LockAspectRatio = True
                End With
                With .AddLabel(1, Tabelle1.Shapes(c00).Left + 6, Tabelle1.Shapes(c00).Top + 15, 58, 33).TextFrame
                    .Parent.Name = "T_" & Format(j, "00")
                    .AutoSize = False
                    .MarginLeft = 0
                    .MarginRight = 0
                    .MarginBottom = 0
                    .MarginTop = 0
                    .VerticalAlignment = -4108
                    .HorizontalAlignment = -4108
                    .Characters.Font.Color = RGB(0, 0, 0)
                End With
            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
        Tabelle1.Shapes("C_" & Format(jj, "00")).Fill.ForeColor.RGB = RGB(220, 220, 220)
        With Tabelle1.Shapes("T_" & Format(jj, "00")).TextFrame.Characters
           .Text = sn(Abs(Int((j - 2) * Rnd() - 0.01)) + 2, y)
           .Font.Color = RGB(0, 0, 0)
         End With
    Next
    
   With Tabelle1
       .[N1:N61] = "=rand()"
        sp = [index(rank(T_OLE!N1:N61,T_OLE!N1:N61)-1,)]
        .Range("P1:P61") = sp
       .[N1:N61].ClearContents
    End With
    For j = 1 To 12
       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = RGB(0, 0, 255)
       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
    Next
    For j = 13 To 16
       Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = RGB(200, 100, 0)
       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 0)
    Next
       Tabelle1.Shapes("C_" & Format(sp(17, 1), "00")).Fill.ForeColor.RGB = RGB(100, 100, 100)
       Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(0, 0, 0)
   

End Sub

Makro wurde 2x verändert!

[snb]

Bitte:

Analysiere mal erst diese Code:

Code:

    .[K1:K61] = "=rand()"
   sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
   .[K1:K61].ClearContents

[BoskoBiati]

Hi,

ob ich den analysiere oder nicht, ich kriege die Felder nicht, die ich brauche: 12x blau, 4x braun und 1x grau.

Das ist der falsche Ansatz:

Code:

For j = 1 To 14
      Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
      Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
   Next
End Sub

Habe den Code nochmals angepasst.


  Spielerei snb.xlsb (Größe: 38,04 KB / Downloads: 1)

[snb]

Eine neue 'Glaskugelbedingung' ?

Code:

   With Tabelle1
       .[K1:K61] = "=rand()"
        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
       .[K1:K61].ClearContents
    End With
    
    st = Array(0, 0, 0)
    For j = 1 To UBound(sp)
       If (sp(j, 1) < 27) * (st(0) < 12) + (sp(j, 1) > 26) * (sp(j, 1) < 37) * (st(1) < 4) + (sp(j, 1) > 26) * (st(2) < 1) <> 0 Then
        st(0) = st(0) - (sp(j, 1) < 27)
        st(1) = st(1) + ((sp(j, 1) > 26) * (sp(j, 1) < 38))
        st(2) = st(2) - (sp(j, 1) > 37)
        
        Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(sp(j, 1) < 27, RGB(0, 0, 255), IIf(sp(j, 1) < 38, RGB(200, 100, 0), RGB(100, 100, 100)))
        Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
       End If

[BoskoBiati]

Hi,

Eine neue 'Glaskugelbedingung' ?

siehe Beitrag #16

da sp aus zufällig angeordneten Zahlen zwischen 1 u. 61 besteht, nehme ich die ersten 12 und mache die entsprechenden Felder blau, die nächsten 4 braun und das letzte grau. Das passt wunderbar.

Code:

For j = 1 To 17
      Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(j < 13, RGB(0, 0, 255), IIf(j < 17, RGB(200, 100, 0), RGB(100, 100, 100)))
      Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
   Next

Außerdem muß ich eines der Themen aus der Liste zufällig auswählen, nach dem richtet sich die Belegung der Felder. Du hast die Zuordnung der Zahlen aus der Liste zu den Begriffen gelöscht. Die waren aber von Thema zu Thema unterschiedlich. Manche Zahlenbereiche waren größer, andere kleiner, was eine Wichtung bei Zufallszahlen bewirkt.

[snb]

In #16 erwähnst du 9 Blaue Felder  ???

Letztendlich reicht dann doch:

Code:

   With Tabelle1
       .[K1:K61] = "=rand()"
        sp = [index(rank(T_OLE!K1:K61,T_OLE!K1:K61)-1,)]
       .[K1:K61].ClearContents
    End With
    
    For j = 1 To 17
        Tabelle1.Shapes("C_" & Format(sp(j, 1), "00")).Fill.ForeColor.RGB = IIf(j < 13, RGB(0, 0, 255), IIf(j < 17, RGB(200, 100, 0), RGB(100, 100, 100)))
        Tabelle1.Shapes("T_" & Format(sp(j, 1), "00")).TextFrame.Characters.Font.Color = RGB(255, 255, 255)
    Next

[BoskoBiati]

Hi,

ja, so habe ich es auch mittlerweile in meinem Code stehen. Es waren zuerst 9, später dann 12 blaue Felder. Das ist aber nur eine Marginalie, am System ändert sich nichts.

[snb]

Die waren aber von Thema zu Thema unterschiedlich.
Manche Zahlenbereiche waren größer, andere kleiner, was eine Wichtung bei Zufallszahlen bewirkt.

Und das gerade versteh ich nicht.

Basiert auf zufall wird Gruppe 1,2,3,4,5 oder 6 gewählt.
Dann werden die 'items' der gewählte Gruppe basiert auf Zufall den 61 'Felder' zugewiesen ?

Oder ??

[BoskoBiati]

Hi,

prinzipiell hast Du recht. Aber, es werden Zufallszahlen in einem Bereich von 1 bis 200 ausgewürfelt. Diese Zahlen werden einem Begriff zugeordnet:

Arbeitsblatt mit dem Namen 'Liste'
	E	F	G	H
1	Statistics Elysium Board		The Wasteland
2	1	Empty	1	Empty
3	62	Steel	108	2 Heat
4	78	2 Steel	131	3 Heat
5	91	Titan	144	Card
6	101	2 Titan	154	Steel
7	104	Plant/Steel	174	2 Steel
8	107	Plant/Titan	181	Titan
9	110	Plant	188	Plant
10	153	2 Plants
11	179	3 Plants
12	182	Card
13	198	3 Cards

Diese Tabelle wurde mit Tab2Html (v2.4.1) erstellt. ©Gerd alias Bamberg

Du siehst also, dass die Zahlenbereiche (von denen ich hier nur die Startzahl stehen habe) unterschiedlich sind. Die Wahrscheinlichkeiten für das Auftreten der einzelnen Begriffe sind also unterschiedlich hoch. Das muß einfach im Code implementiert sein.