④Microsoft Visual Basic for Applications」にて以下のコードを記載
Sub CreateQrcode()
'開始行
Dim firstRow As Long: firstRow = 3
'最終行の取得
Dim lastRow As Long: lastRow = Cells(Rows.Count, 1).End(xlUp).Row
'firstRow～lastRowまで繰り返し(途中エラーが出た場合も止めずに最後まで処理)
On Error Resume Next
For i = firstRow To lastRow
'QRコード表示セルの高さなどを調整
With Cells(i, "B")
.RowHeight = 65
.VerticalAlignment = xlTop '上詰め
End With
'GoogleAPIでQRコードを作成
Set qr = ActiveSheet.Pictures _
.Insert("http://chart.apis.google.com/chart?cht=qr&chs=80x80&chl=" _
+ Cells(i, "A").Value)
'QRコードの表示位置を指定
With qr
.Top = Cells(i, "B").Top + 2
.Left = Cells(i, "B").Left + 2
End With
Next i
On Error GoTo 0
End Sub
⑤「Microsoft Visual Basic for Applications」にて以下のコードを記載
必要に応じて「★」のついた箇所を変更
Sub Addup_Click()
Call ReadCSV
End Sub
Function ReadCSV()
'★読み込み対象ファイルの絶対パスを指定
Dim filePass As String: filePass = "C:\SalesData.csv"
'★書き込みを開始する行・列を指定
Dim startRow As Integer: startRow = 2
Dim startCol As Integer: startCol = 1
'★定期実行する間隔を指定
Dim waitSec As Single: waitSec = 5
Dim targetRow As Integer: targetRow = startRow
Dim targetCol As Integer: targetCol = startCol
Dim rowBuf As String
Dim cellBufList As Variant
Open filePass For Input As #1
'全行読み込み終わるまで繰り返し
Do Until EOF(1)
'１行読み込み
Line Input #1, rowBuf
'読みこんだ１行をカンマで区切り配列化
cellBufList = Split(rowBuf, ",")
'配列分繰り返し
For Each cellBuf In cellBufList
Cells(targetRow, targetCol).Value = cellBuf
'次の列へ
targetCol = targetCol + 1
Next cellBuf
'次の行へ
targetCol = startCol
targetRow = targetRow + 1
Loop
Close #1
'ピボットテーブルの更新
Dim pvt As PivotTable
For Each pvt In ActiveSheet.PivotTables
pvt.PivotCache.Refresh
Next
'待機処理
Dim Tm As Single
Tm = Timer
Do
DoEvents
Loop Until Timer > Tm + waitSec
'再帰
Call ReadCSV
End Function
②Microsoft Visual Basic for Applications」にて以下のコードを記載
Sub Bingo()
'結果
Dim result As Integer
'(これまでに出た)結果リスト
Dim resultList As Variant: resultList = Range("A21:A95")
'1～75まで全て出ている場合はなにもしない
If (IsEmpty(Range("A95").Value) = False) Then
GoTo PROCESSINGEXIT
End If
'ボタンを配置したセルを選択する
Cells(1, 13).Select
'フォントサイズを設定
Worksheets("BINGO").Range("A2").Font.Size = 350
'ルーレット表示
For i = 1 To 100
Application.Wait [Now()] + 5 / 86400000
result = Int(75 * Rnd + 1)
Worksheets("BINGO").Range("A2").Value = result
Next
'重複制御
Do While (1)
result = Int(75 * Rnd + 1)
For i = 1 To UBound(resultList)
If (resultList(i, 1) = result) Then
GoTo BREAK
End If
Next
Exit Do
BREAK:
Loop
Worksheets("BINGO").Range("A2").Value = result
'結果書き込み
For i = 1 To UBound(resultList)
If (IsEmpty(Cells(i + 20, 1).Value) = True) Then
Cells(i + 20, 1).Value = result
Exit For
Else
GoTo CONTINUE
End If
CONTINUE:
Next
PROCESSINGEXIT:
End Sub
Sub Initialize()
Range("A21:A95").ClearContents<img src="https://exceldemon.net/wp-content/uploads/2018/11/条件付き書式.png" alt="" width="379" height="396" class="alignnone size-full wp-image-432" />
Worksheets("BINGO").Range("A2").Font.Size = 15
Worksheets("BINGO").Range("A2").Value = "Please press ""BINGO"" button"
End Sub
③条件付き書式を設定
※すでに出た数値の背景色を緑色とする
プログラムの解説
'ルーレット表示
For i = 1 To 100
Application.Wait [Now()] + 5 / 86400000
result = Int(75 * Rnd + 1)
Worksheets("BINGO").Range("A2").Value = result
Next
'重複制御
Do While (1)
result = Int(75 * Rnd + 1)
For i = 1 To UBound(resultList)
If (resultList(i, 1) = result) Then
GoTo BREAK
End If
Next
Exit Do
BREAK:
Loop
Worksheets("BINGO").Range("A2").Value = result
「Do While (1)」で無限ループを発生。
「result = Int(75 * Rnd + 1)」でresultに1～75のランダムな数値を格納する。
「For i = 1 To UBound(resultList)～Next」でresultList分ループし、
resultListにresultの数値がすでに含まれている場合はBREAKして再度1～75のランダムな数値を格納し直す。
含まれていない数値だった場合は「Exit Do」でループを抜けて、「A2」にresultの数値をセット。
'結果書き込み
For i = 1 To UBound(resultList)
If (IsEmpty(Cells(i + 20, 1).Value) = True) Then
Cells(i + 20, 1).Value = result
Exit For
Else
GoTo CONTINUE
End If
CONTINUE:
Next
「For i = 1 To UBound(resultList)～Next」でresultList分ループし、
値が入っていないCellまで来たら今回Resultに格納している数値を書き込む
Sub Initialize()
Range("A21:A95").ClearContents
Worksheets("BINGO").Range("A2").Font.Size = 15
Worksheets("BINGO").Range("A2").Value = "Please press ""BINGO"" button"
End Sub
