QRコードで提出物管理・出席管理をするシステムのつくりかた

仕事
2024.12.27

仕事で複数人の提出物を管理するのだが、毎回紙でチェックするのは面倒くさい！一人ずつにQRコードを渡して出席を確認出来たら便利だなぁ。と思ってChatGPTで作ってみました。中身を少し変えれば、出席の管理にも使えます。読んだ方が同じようにCharGPTを使用したシステム開発ができるように、本記事では、どのようにChatGPTに質問をして作ったのか順を追って記載します。

Contents
  1. 開発の流れ
  2. ①仕様を具体的に固める
  3. ②ChatGPTに質問してプログラムを大まかに作る
  4. ③プログラムを動かしてみる
  5. ④イメージと違うところをChatGPTに伝えて修正したプログラムを作る
  6. ⑤想定通りに動くまで③④を繰り返す
  7. 今回完成したシステム
  8. 終わりに

開発の流れ

ChatGPTに「QRコードで出席管理をするシステムを作って！」とお願いしても、すぐには完成しません。具体的にどのような仕様にするのかを固めておく必要があります。

開発の流れは、大まかに以下の順で行います。

①仕様を具体的に固める。

②ChatGPTに質問してプログラムを大まかに作る。

③プログラムを動かしてみる。

④イメージと違うところをChatGPTに伝えて修正したプログラムを作る。

⑤想定通りに動くまで③④を繰り返す。

①仕様を具体的に固める

イメージ通りのプログラムを作るには、どんな言語を使うのか、どんな方法で行うのか、具体的にChatGPTに伝える必要があります。QRコードリーダーを買えば早いですが、お金をかけずQRコードで読み取った内容を自動でエクセルに貼る方法は思いつかなかったので、一度クリップボードに保存し、保存した内容が自動でエクセルに貼りつけられるようにしました。

・エクセルで管理するためにマクロを使う。　

・日付ごとに提出物を管理できるようにする。

・QRコードにメンバーに振り分けた番号を入れておき、読み取った値をクリップボードに保存する。その値をエクセルから探して、QRコードをかざしたメンバーに「提出済み」が入力されるようにする。

最終的に下記画像のようになるイメージで作り始めました。

②ChatGPTに質問してプログラムを大まかに作る

ChatGPTにした質問は下記です。

質問する際、先に枠を作って添付しておくとイメージとずれません。今回はエクセルで枠をつくって添付しました。

Clipboard Tracking_Ver1
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function StrPtrToString Lib "kernel32" Alias "lstrcpyA" (ByVal lpDest As String, ByVal lpSrc As LongPtr) As String

Private Const CF_TEXT As Long = 1

Private Sub Workbook_Open()
    ' 開始時に監視を開始
    StartClipboardMonitor
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 終了時に監視を停止
    StopClipboardMonitor
End Sub

Private monitorEnabled As Boolean

Public Sub StartClipboardMonitor()
    monitorEnabled = True
    Do While monitorEnabled
        Dim clipboardText As String
        clipboardText = GetClipboardText()

        If clipboardText <> "" Then
            ' Sheet2のA2セルに値を設定
            Dim ws As Worksheet
            Set ws = ThisWorkbook.Sheets("Sheet2")
            
            Application.EnableEvents = False
            ws.Range("A2").Value = clipboardText
            Application.EnableEvents = True
            
            ' 提出済みの処理を実行
            ProcessSubmission clipboardText
        End If

        ' 500ミリ秒待機
        Sleep 500
    Loop
End Sub

Public Sub StopClipboardMonitor()
    monitorEnabled = False
End Sub

Private Function GetClipboardText() As String
    Dim hClipMemory As LongPtr
    Dim lpClipMemory As LongPtr
    Dim clipboardText As String
    Dim clipboardLength As Long

    On Error GoTo ClipboardError

    ' クリップボードを開く
    If OpenClipboard(0) = 0 Then GoTo ClipboardError

    ' クリップボード内のデータを取得
    hClipMemory = GetClipboardData(CF_TEXT)
    If hClipMemory = 0 Then GoTo ClipboardError

    ' データをロックして文字列に変換
    lpClipMemory = GlobalLock(hClipMemory)
    clipboardLength = lstrlen(lpClipMemory)
    clipboardText = Space$(clipboardLength)
    StrPtrToString clipboardText, lpClipMemory
    GlobalUnlock hClipMemory

    ' クリップボードを閉じる
    CloseClipboard
    GetClipboardText = clipboardText
    Exit Function

ClipboardError:
    CloseClipboard
    GetClipboardText = ""
End Function

Private Sub ProcessSubmission(ByVal submissionNumber As String)
    Dim currentDate As String
    Dim targetSheet As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range

    ' 現在の日付を取得してフォーマット
    currentDate = Format(Date, "yyyy-mm-dd")

    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets(currentDate)
    On Error GoTo 0

    If Not targetSheet Is Nothing Then
        ' A列を検索
        Set searchRange = targetSheet.Columns("A")
        Set foundCell = searchRange.Find(What:=submissionNumber, LookIn:=xlValues, LookAt:=xlWhole)

        If Not foundCell Is Nothing Then
            ' C列に「提出済み」を入力
            targetSheet.Cells(foundCell.Row, "C").Value = "提出済み"
        End If
    End If
End Sub

作ってくれました。このVBAコードをエクセルに貼りつけて実装します。

③プログラムを動かしてみる

コードを貼り付けるVBAエディタなどの説明は割愛します。

まだQRコードの読み取り部分は作れていないため、マクロ実行後、文字を打って、コピーすることでクリップボードに貼り付けました。

［実装結果］マクロを動かすと、エクセルが固まって動かなくなった。

原因を探ると、マクロが絶えず繰り返しクリップボードを監視してエクセルに貼りつける動作をしており、処理がループしていました。これでは一人目が提出したタイミングでエクセルが止まってしまい、二人目が提出できません。。

一度クリップボードをチェックしたら、処理を止める必要がありそうです。

④イメージと違うところをChatGPTに伝えて修正したプログラムを作る

無限ループを解消するために、次は以下の質問をしました。

Clipboard Tracking_Ver2
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function StrPtrToString Lib "kernel32" Alias "lstrcpyA" (ByVal lpDest As String, ByVal lpSrc As LongPtr) As String

Private Const CF_TEXT As Long = 1

Private lastClipboardText As String

Private Sub Workbook_Open()
    ' 開始時に監視を開始
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 終了時に監視を停止
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard", , False
    On Error GoTo 0
End Sub

Public Sub MonitorClipboard()
    Dim clipboardText As String
    clipboardText = GetClipboardText()

    If clipboardText <> "" And clipboardText <> lastClipboardText Then
        lastClipboardText = clipboardText

        ' Sheet2のA2セルに値を設定
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("Sheet2")
        
        Application.EnableEvents = False
        ws.Range("A2").Value = clipboardText
        Application.EnableEvents = True
        
        ' 提出済みの処理を実行
        ProcessSubmission clipboardText
    End If

    ' 次の監視をスケジュール
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Function GetClipboardText() As String
    Dim hClipMemory As LongPtr
    Dim lpClipMemory As LongPtr
    Dim clipboardText As String
    Dim clipboardLength As Long

    On Error GoTo ClipboardError

    ' クリップボードを開く
    If OpenClipboard(0) = 0 Then GoTo ClipboardError

    ' クリップボード内のデータを取得
    hClipMemory = GetClipboardData(CF_TEXT)
    If hClipMemory = 0 Then GoTo ClipboardError

    ' データをロックして文字列に変換
    lpClipMemory = GlobalLock(hClipMemory)
    clipboardLength = lstrlen(lpClipMemory)
    clipboardText = Space$(clipboardLength)
    StrPtrToString clipboardText, lpClipMemory
    GlobalUnlock hClipMemory

    ' クリップボードを閉じる
    CloseClipboard
    GetClipboardText = clipboardText
    Exit Function

ClipboardError:
    CloseClipboard
    GetClipboardText = ""
End Function

Private Sub ProcessSubmission(ByVal submissionNumber As String)
    Dim currentDate As String
    Dim targetSheet As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range

    ' 現在の日付を取得してフォーマット
    currentDate = Format(Date, "yyyy-mm-dd")

    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets(currentDate)
    On Error GoTo 0

    If Not targetSheet Is Nothing Then
        ' A列を検索
        Set searchRange = targetSheet.Columns("A")
        Set foundCell = searchRange.Find(What:=submissionNumber, LookIn:=xlValues, LookAt:=xlWhole)

        If Not foundCell Is Nothing Then
            ' C列に「提出済み」を入力
            targetSheet.Cells(foundCell.Row, "C").Value = "提出済み"
        End If
    End If
End Sub

無限ループが解消されました！

「1」を入力してコピーすると、エクセルに貼りつけられ、それをチェックして同じ番号のメンバーが「提出済み」になるようになりました。

⑤想定通りに動くまで③④を繰り返す

今後、複数の提出を求める場合を考え、３つの提出物を管理できるようにしていきます。

ちょっとくどいくらいで質問してみました。

Clipboard Tracking_Ver3
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function StrPtrToString Lib "kernel32" Alias "lstrcpyA" (ByVal lpDest As String, ByVal lpSrc As LongPtr) As String

Private Const CF_TEXT As Long = 1

Private lastClipboardText As String

Private Sub Workbook_Open()
    ' 開始時に監視を開始
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 終了時に監視を停止
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard", , False
    On Error GoTo 0
End Sub

Public Sub MonitorClipboard()
    Dim clipboardText As String
    clipboardText = GetClipboardText()

    If clipboardText <> "" And clipboardText <> lastClipboardText Then
        lastClipboardText = clipboardText

        ' Sheet2のA2セルに値を設定
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("Sheet2")
        
        Application.EnableEvents = False
        ws.Range("A2").Value = clipboardText
        Application.EnableEvents = True
        
        ' 提出済みの処理を実行
        ProcessSubmission clipboardText
    End If

    ' 次の監視をスケジュール
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Function GetClipboardText() As String
    Dim hClipMemory As LongPtr
    Dim lpClipMemory As LongPtr
    Dim clipboardText As String
    Dim clipboardLength As Long

    On Error GoTo ClipboardError

    ' クリップボードを開く
    If OpenClipboard(0) = 0 Then GoTo ClipboardError

    ' クリップボード内のデータを取得
    hClipMemory = GetClipboardData(CF_TEXT)
    If hClipMemory = 0 Then GoTo ClipboardError

    ' データをロックして文字列に変換
    lpClipMemory = GlobalLock(hClipMemory)
    clipboardLength = lstrlen(lpClipMemory)
    clipboardText = Space$(clipboardLength)
    StrPtrToString clipboardText, lpClipMemory
    GlobalUnlock hClipMemory

    ' クリップボードを閉じる
    CloseClipboard
    GetClipboardText = clipboardText
    Exit Function

ClipboardError:
    CloseClipboard
    GetClipboardText = ""
End Function

Private Sub ProcessSubmission(ByVal submissionData As String)
    Dim currentDate As String
    Dim targetSheet As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim searchNumber As String
    Dim columnOffset As Integer
    Dim splitData() As String

    ' 現在の日付を取得してフォーマット
    currentDate = Format(Date, "yyyy-mm-dd")

    ' データを分割
    splitData = Split(submissionData, "-")
    If UBound(splitData) <> 1 Then Exit Sub ' 無効な形式

    searchNumber = splitData(0)
    columnOffset = Val(splitData(1))  ' C列は1, D列は2,E列は3...

    If columnOffset < 0 Then Exit Sub ' 無効な列指定

    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets(currentDate)
    On Error GoTo 0

    If Not targetSheet Is Nothing Then
        ' A列を検索
        Set searchRange = targetSheet.Columns("A")
        Set foundCell = searchRange.Find(What:=searchNumber, LookIn:=xlValues, LookAt:=xlWhole)

        If Not foundCell Is Nothing Then
            ' 対応する列に「提出済み」を入力
            targetSheet.Cells(foundCell.Row, columnOffset + 2).Value = "出したよ！"
        End If
    End If
End Sub

できました！

QRコードの読み取りは、chromeの拡張機能の「QR Scanner」を使用しました。これもボタンを押したら呼び出せるようにしました。

QR Scanner を起動
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub QR Scanner を起動()
    Dim chromePath As String
    Dim qrScannerURL As String
    Dim clipboardData As DataObject
    Dim targetCell As Range
    
    ' Chromeのパスを指定（必要に応じて変更）
    chromePath = """C:\Program Files\Google\Chrome\Application\\chrome.exe"""
    
    ' QRコードリーダー拡張機能のURL（QR ScannerのURLを設定）
    qrScannerURL = "chrome-extension://（QR ScannerのID）/popup.html"
    
    ' Chromeをコマンドラインで起動
    Shell chromePath & " " & qrScannerURL, vbNormalFocus
    
End Sub

ちなみにQRコードもChatGPTで作りました。

今回完成したシステム

Clipboard Tracking_Ver3
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Private Declare PtrSafe Function OpenClipboard Lib "user32" (ByVal hwnd As Long) As Long
Private Declare PtrSafe Function GetClipboardData Lib "user32" (ByVal wFormat As Long) As Long
Private Declare PtrSafe Function CloseClipboard Lib "user32" () As Long
Private Declare PtrSafe Function GlobalLock Lib "kernel32" (ByVal hMem As LongPtr) As LongPtr
Private Declare PtrSafe Function GlobalUnlock Lib "kernel32" (ByVal hMem As LongPtr) As Long
Private Declare PtrSafe Function lstrlen Lib "kernel32" Alias "lstrlenA" (ByVal lpString As LongPtr) As Long
Private Declare PtrSafe Function StrPtrToString Lib "kernel32" Alias "lstrcpyA" (ByVal lpDest As String, ByVal lpSrc As LongPtr) As String

Private Const CF_TEXT As Long = 1

Private lastClipboardText As String

Private Sub Workbook_Open()
    ' 開始時に監視を開始
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
    ' 終了時に監視を停止
    On Error Resume Next
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard", , False
    On Error GoTo 0
End Sub

Public Sub MonitorClipboard()
    Dim clipboardText As String
    clipboardText = GetClipboardText()

    If clipboardText <> "" And clipboardText <> lastClipboardText Then
        lastClipboardText = clipboardText

        ' Sheet2のA2セルに値を設定
        Dim ws As Worksheet
        Set ws = ThisWorkbook.Sheets("Sheet2")
        
        Application.EnableEvents = False
        ws.Range("A2").Value = clipboardText
        Application.EnableEvents = True
        
        ' 提出済みの処理を実行
        ProcessSubmission clipboardText
    End If

    ' 次の監視をスケジュール
    Application.OnTime Now + TimeValue("00:00:01"), "MonitorClipboard"
End Sub

Private Function GetClipboardText() As String
    Dim hClipMemory As LongPtr
    Dim lpClipMemory As LongPtr
    Dim clipboardText As String
    Dim clipboardLength As Long

    On Error GoTo ClipboardError

    ' クリップボードを開く
    If OpenClipboard(0) = 0 Then GoTo ClipboardError

    ' クリップボード内のデータを取得
    hClipMemory = GetClipboardData(CF_TEXT)
    If hClipMemory = 0 Then GoTo ClipboardError

    ' データをロックして文字列に変換
    lpClipMemory = GlobalLock(hClipMemory)
    clipboardLength = lstrlen(lpClipMemory)
    clipboardText = Space$(clipboardLength)
    StrPtrToString clipboardText, lpClipMemory
    GlobalUnlock hClipMemory

    ' クリップボードを閉じる
    CloseClipboard
    GetClipboardText = clipboardText
    Exit Function

ClipboardError:
    CloseClipboard
    GetClipboardText = ""
End Function

Private Sub ProcessSubmission(ByVal submissionData As String)
    Dim currentDate As String
    Dim targetSheet As Worksheet
    Dim searchRange As Range
    Dim foundCell As Range
    Dim searchNumber As String
    Dim columnOffset As Integer
    Dim splitData() As String

    ' 現在の日付を取得してフォーマット
    currentDate = Format(Date, "yyyy-mm-dd")

    ' データを分割
    splitData = Split(submissionData, "-")
    If UBound(splitData) <> 1 Then Exit Sub ' 無効な形式

    searchNumber = splitData(0)
    columnOffset = Val(splitData(1))  ' C列は1, D列は2,E列は3...

    If columnOffset < 0 Then Exit Sub ' 無効な列指定

    On Error Resume Next
    Set targetSheet = ThisWorkbook.Sheets(currentDate)
    On Error GoTo 0

    If Not targetSheet Is Nothing Then
        ' A列を検索
        Set searchRange = targetSheet.Columns("A")
        Set foundCell = searchRange.Find(What:=searchNumber, LookIn:=xlValues, LookAt:=xlWhole)

        If Not foundCell Is Nothing Then
            ' 対応する列に「提出済み」を入力
            targetSheet.Cells(foundCell.Row, columnOffset + 2).Value = "出したよ！"
        End If
    End If
End Sub
QR Scanner を起動
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)
Sub QR Scanner を起動()
    Dim chromePath As String
    Dim qrScannerURL As String
    Dim clipboardData As DataObject
    Dim targetCell As Range
    
    ' Chromeのパスを指定（必要に応じて変更）
    chromePath = """C:\Program Files\Google\Chrome\Application\\chrome.exe"""
    
    ' QRコードリーダー拡張機能のURL（QR ScannerのURLを設定）
    qrScannerURL = "chrome-extension://（QR ScannerのID）/popup.html"
    
    ' Chromeをコマンドラインで起動
    Shell chromePath & " " & qrScannerURL, vbNormalFocus
    
End Sub

提出物チェック時の事前準備

⓪事前にQRコードを配布しておく。

⓪マクロを登録したエクセルを開く

①宿題チェック（Clipboard Tracking_Ver3）を起動

　クリップボードの監視、貼り付けと「提出済み」の入力ができるようになります。

②カメラを表示（QR Scanner を起動）

　QR Scannerが表示される。

提出時

③QRコードをカメラで読み取る。

④自分の番号が表示されたら、赤丸をクリックしてクリップボードに貼り付ける。

⑤提出したものが「提出済み」になる。

終わりに

今回まずは最低限のものを作ってみました。シートを自動で複製したりと改善の余地はあると思います。コードを読む力は若干は必要ですが、ChatGPTを使えば簡単に業務効率を図ることができます。ぜひ試してみてください。

コメント