Dieses Forum nutzt Cookies
Dieses Forum verwendet Cookies, um deine Login-Informationen zu speichern, wenn du registriert bist, und deinen letzten Besuch, wenn du es nicht bist. Cookies sind kleine Textdokumente, die auf deinem Computer gespeichert werden. Die von diesem Forum gesetzten Cookies werden nur auf dieser Website verwendet und stellen kein Sicherheitsrisiko dar. Cookies aus diesem Forum speichern auch die spezifischen Themen, die du gelesen hast und wann du zum letzten Mal gelesen hast. Bitte bestätige, ob du diese Cookies akzeptierst oder ablehnst.

Ein Cookie wird in deinem Browser unabhängig von der Wahl gespeichert, um zu verhindern, dass dir diese Frage erneut gestellt wird. Du kannst deine Cookie-Einstellungen jederzeit über den Link in der Fußzeile ändern.

VBA Backcolor in CommandButton führt zu Fehlern
#41
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


Angehängte Dateien
.xlsb   __Spielerei snb.xlsb (Größe: 36,85 KB / Downloads: 10)
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#42
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!
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#43
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#44
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.


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

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#45
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


Angehängte Dateien
.xlsb   __Spielerei snb.xlsb (Größe: 37,02 KB / Downloads: 3)
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#46
Hi,


Zitat: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.
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#47
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
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#48
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.
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top
#49
Zitat: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 ??
Zum übersetzen von Excel Formeln:

http://dolf.trieschnigg.nl/excel/index.p...gids=en+de
Antworten Top
#50
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'
 EFGH
1Statistics Elysium BoardThe Wasteland
21Empty1Empty
362Steel1082 Heat
4782 Steel1313 Heat
591Titan144Card
61012 Titan154Steel
7104Plant/Steel1742 Steel
8107Plant/Titan181Titan
9110Plant188Plant
101532 Plants  
111793 Plants  
12182Card  
131983 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.
Gruß

Edgar

Meine Antworten sind freiwillig und ohne Gewähr!
Über Rückmeldungen würde ich mich freuen.
Antworten Top


Gehe zu:


Benutzer, die gerade dieses Thema anschauen: 1 Gast/Gäste