如何用 vb 生成 1800 張 不同的 bingo card ?

2006-12-08 9:29 pm
bingo card 規格:

7x7 (no free space)

number 為 1 - 100

每張card 必需有49 個不同的number

然後生成1800 張不同的 card

最後可生成 .txt 檔 以方便列印

有難道吧?

回答 (2)

2006-12-08 10:38 pm
✔ 最佳答案
please try following code.
just do it with excel vba, ok?
only generate 64 times. just amend the sub CallAll to generate 1800 times and the path.

Public aBingo(49) As Integer

Sub FileOut(sFile As String)
Dim i, j As Integer
Dim sLine As String
Open sFile For Output As #1
For i = 0 To 6
sLine = ""
For j = 0 To 6
sLine = sLine & Trim(Val(aBingo(i * 7 + j))) & ","
Next
Print #1, Left(sLine, Len(sLine) - 1)
' MsgBox Left(sLine, Len(sLine) - 1)
Next
Close #1
End Sub

Sub BingoGen()
Dim i, j As Integer
Dim a(48) As Integer
i = 0
Do
j = Int((49 * Rnd) + 1)
If a(j - 1) <> 1 Then
aBingo(i) = j
a(j - 1) = 1
i = i + 1
End If
If i >= 49 Then
Exit Do
End If
Loop
End Sub

Sub CallAll()
Dim i As Integer
Dim sFileName As String
For i = 1 To 64
sFileName = Trim(Str(Val(i)))
sFileName = "C:\TEMP\B_" & String(4 - Len(sFileName), "0") & sFileName & ".TXT"
Call BingoGen
Call FileOut(sFileName)
Next
End Sub

hope can help u
2006-12-11 9:53 am
Excel VBA
1.) 首先將 Sheet1 B2:H8 (即 7 x 7)劃妥格線/外框
再調節欄寬及列高; 水平及垂直調至置中位置; 預覽列印調節周界
達到最佳的列印效果。
2.) 程式:
Sub bingox()
Dim bingo(100)
cards = 1800
Set aaa = Range(&quot;B2:H8&quot;)
For c = 1 To cards
aaa.ClearContents
For t = 1 To 100
bingo(t) = 0
Next t
For x = 1 To 49
rernd:
a = Int(Rnd() * 100 + 1)
If bingo(a) &gt; 0 Then GoTo rernd
bingo(a) = a
aaa(x) = a
Next x
ActiveWindow.SelectedSheets.PrintOut Copies:=1, Collate:=True
Next c
End Sub
3.) 如 500張咭, 1 - 150, 5 x 5 = 25
程式便要將
1800 改成 500
100 改成 150
49 改成 25
Range(&quot;B2:H8&quot;) 改成 Range(&quot;B2:F6&quot;)
4.) 由於程式(即巨集)執行時, 即馬上進行列印, 建議先將 Cards 改成5以下,測試效果。
5.) 如需(在Sheet2做資料庫)儲存每張咭的資料及加上編號, 程式亦不太複雜, 如需要請再提問。先做妥資料庫, 再進行列印會更安全,當然上述程式要有很多修改。


收錄日期: 2021-04-13 14:46:54
原文連結 [永久失效]:
https://hk.answers.yahoo.com/question/index?qid=20061208000051KK01486

檢視 Wayback Machine 備份