Bingoplader, lige til at klippe ud


Kode:

Public Sub BingoPlader()
Dim C(3) As Variant, UU(3) As Integer, X As Variant, U As Integer, I As Integer, Lille As Variant, Stor As Variant
Dim NyPlade As Integer
Columns("A:K").Clear
 Q = InputBox(" indtast antal plader", "Antal plader", 1)
 Application.ScreenUpdating = False
   Lille = Array(1, 10, 20, 30, 40, 50, 60, 70, 80) ' mindste værdier
    Stor = Array(9, 19, 29, 39, 49, 59, 69, 79, 90) ' største værdier
      NyPlade = 2
     R = 1
     T = 0

    '****************************** Tilpasser pladen på arket ****************
   
      Columns("B:J").ColumnWidth = 8
      Range("K:K,A:A").Select
      Range("A1").ColumnWidth = 2
      Selection.ColumnWidth = 2
      Rows("1:1").RowHeight = 12
      Range(Cells(1, 1), Cells(1, 11)).Interior.ColorIndex = 40
       Sideskift = 0
            For I = 1 To Q
            Sideskift = Sideskift + 1
          Range(Cells(NyPlade, 2), Cells(NyPlade + 2, 10)).Font.Size = 24
          Rows(NyPlade & ":" & NyPlade + 2).RowHeight = 39.75
         Range(Cells(NyPlade, 2), Cells(NyPlade + 2, 10)).Select
           
            Selection.Borders.LineStyle = xlContinuous
          With Selection
           .HorizontalAlignment = xlCenter
           .VerticalAlignment = xlCenter
         End With
          Rows(NyPlade + 3).RowHeight = 20
          Range(Cells(NyPlade + 3, 1), Cells(NyPlade + 3, 11)).Interior.ColorIndex = 40
        
         If Sideskift = 5 Then
           If I = Q Then
              NyPlade = NyPlade + 4
            Else
               Sideskift = 0
               Rows(NyPlade + 4).RowHeight = 20
               Range(Cells(NyPlade + 4, 1), Cells(NyPlade + 4, 11)).Interior.ColorIndex = 40
               NyPlade = NyPlade + 5
         End If
         Else
         NyPlade = NyPlade + 4
         End If
         Next
        Range(Cells(1, 1), Cells(NyPlade - 1, 1)).Interior.ColorIndex = 40
        Range(Cells(1, 11), Cells(NyPlade - 1, 11)).Interior.ColorIndex = 40
     Range("A1").Select
  '*********************************** Tilpasser pladen slut ****************
   NyPlade = 2
   Sideskift = 0
  For ny = 1 To Q
   Sideskift = Sideskift + 1
  A = Int(Rnd * 9) + 1 ' Randum fordeling
 '****************************** Tilpasser Antal på pladen ****************
Select Case A
   Case 1
    R1 = Array(2, 1, 2, 1, 3, 2, 2, 1, 1)
   Case 2
    R1 = Array(1, 1, 3, 2, 1, 1, 2, 3, 1)
   Case 3
    R1 = Array(1, 2, 1, 3, 1, 2, 1, 2, 2)
   Case 4
    R1 = Array(2, 2, 1, 1, 1, 1, 3, 2, 2)
    Case 5
    R1 = Array(1, 2, 2, 1, 3, 2, 2, 1, 1)
    Case 6
    R1 = Array(3, 2, 1, 2, 2, 2, 1, 1, 1)
    Case 7
    R1 = Array(1, 2, 2, 2, 1, 3, 1, 1, 2)
    Case 8
    R1 = Array(3, 1, 2, 2, 1, 1, 2, 1, 2)
    Case 9
    R1 = Array(1, 2, 1, 1, 2, 1, 1, 3, 3)
  End Select
    '****************************** Tilpasser Antal slut ****************
   
   
For T = 0 To 8 ' 9 kolonner
  R = R + 1
    For I = 1 To 3 ' antal rækker
   
Start1:
      U = Int(Rnd * 3) + 1 'tilfældig placering på række
   UU(I) = U
    For Y = 1 To I - 1
      If UU(Y) = U Then GoTo Start1
    Next Y
Start2:
         X = Int((Rnd() * (Stor(T) - Lille(T)) + Lille(T)))  + Int(Rnd() * 2)
          If U > R1(T) Then
             Cells(I + (NyPlade - 1), R).Font.Size = 10 ' ændre tekststørrelsen på bart felt
           Cells(I + (NyPlade - 1), R) = "kabbak" ' bart felt
           GoTo BarFelt
         End If
  
  For Y = 1 To I - 1
      If C(Y) = X Then GoTo Start2
    Next Y
   C(Y) = X
  Cells(I + (NyPlade - 1), R) = X
 
BarFelt:
  Next I
  '**************************** sortering **************
  For I = 1 To 3
  If Cells(I + (NyPlade - 1), R).Font.Size = 10 Then GoTo Tekst1
 
  For IV = 1 To 2
   If Cells(IV + (NyPlade - 1), R).Font.Size = 10 Then GoTo Tekst2
  
      If Cells(I + (NyPlade - 1), R) < Cells(IV + (NyPlade - 1), R) Then
         temp = Cells(I + (NyPlade - 1), R)
         Cells(I + (NyPlade - 1), R) = Cells(IV + (NyPlade - 1), R)
         Cells(IV + (NyPlade - 1), R) = temp
  End If
Tekst2:
  Next IV
Tekst1:
  Next I
 
    '**************************** sortering slut **************
 Next T
    If Sideskift = 5 Then
         Sideskift = 0
         NyPlade = NyPlade + 5
         Else
         NyPlade = NyPlade + 4
         End If
 
  R = 1
 Next ny
  Application.ScreenUpdating = True
End Sub