概要
エクセルで作成した定形様式にデータを直接記録し、電子ファイルとして保管する場合などに、VBAプログラムを残したままにして困ることがあります。Office32bit版 から 64bit版 への進化、Office 365 登場 など 利用環境も変化しています。保管だけなら問題ないのかもしれませんが、資料更新が必要な場合に過去のプログラムは動かない可能性があります。また、機能の改善目的でファイルごとにプログラムを修正するのも大変です。
今回、プログラムを含まないブックと含むブックを同時に開いて、含まないブック側のデータ加工等を自動処理できることを知りましたので、手順を整理しておきたいと思います。
処理内容
過去に投稿した「漫画本リスト作成自動化」のプログラムを改造して確認しています。
【参考】エクセルと書籍APIで、漫画本リスト作成自動化
[url] https://kats-eye.net/info/2020/03/20/comic-list-01/
もとのプログラムは、１件づつ ISBN 番号をバーコードリーダーで読み込んで、題名・作者・出版日を検索・リスト追加していくという内容でしたが、今回は予め複数の ISBN 番号が設定されたリストに対して、一括検索する様に変更しています。
次のエクセルブック自体には、VBAプログラムを含まず、同時に開いている他ブックのプログラムで自動処理しています。
他ブックプログラムの起動設定
初期設定では、「開発」タブは表示されていないので、次の手順で表示設定します。
「開発」タブを選択し、「マクロ」をクリックします。
次の様なフォームが表示されます。エクセルブックの実行可能なプログラムがリスト表示されます。（ ‘マクロ保存先’ で対象表示範囲は選択・変更出来ます。）
プログラム選択（⑦）後、‘実行’（⑧）ボタンクリックすると他ブックのプログラムでも実行可能です。
「マクロ」上でマウス右クリックし、‘クイックアクセスツールバーに追加’ を選択すると、最上部のクイックアクセスツールバーに追加できます。「開発」タブを非表示に戻しても、ここをクリックし 上図プログラム選択・実行フォームを直接起動することが出来ます。
プログラムの実行
① プログラム実行
起動設定に記載した通り、プログラムを実行します。今回はプログラムを含まない ‘書籍出荷リスト.xlsx’ のシート内のリストを ‘書籍出荷リスト_VBA.xlsm’ の ‘GetBookInfo’ というプログラムを実行し、データ検索・加工します。
| ブックのファイル名 | プログラム |
|---|---|
| 書籍出荷リスト.xlsx | 無 |
| 書籍出荷リスト_VBA.xlsm | GetBookInfo |
‘書籍出荷リスト.xlsx’ の 対象シートを選択（アクティブ化）した状態で、プログラム選択・実行フォームを開きます。次の様にどのブックのプログラムか判るので、間違えない様に実行します。
複数のプログラム存在する場合、リストに表示されますが、引数や戻り値があるものは表示されない様です。
② プログラム（書籍出荷リスト_VBA.xlsm）
（１）参照設定
今回のテーマとは直接関係ありませんが、ISBN 番号からHTTP通信で書籍情報を検索する為に、次の参照設定が必要です。
（２）プログラム
VBA 標準モジュール の 次のプログラムを実行します。
Option Explicit
'メインプログラム
Public Sub GetBookInfo()
Dim sht
Dim line_cn
Dim isbn_no
Dim book_info
sht = ActiveSheet.Name 'シート名
line_cn = 0
Do
isbn_no = Trim(Worksheets(sht).Cells(5 + line_cn, 3).Value)
If isbn_no = "" Then Exit Do
book_info = HTTP_REQ(isbn_no)
If book_info = "[null]" Then
Worksheets(sht).Cells(5 + line_cn, 4).Value = "データ無！"
ElseIf book_info <> "ERR" Then
Call JSON_analyzer_api_openbd(book_info, isbn_no, sht, 5 + line_cn)
Else
Worksheets(sht).Cells(5 + line_cn, 4).Value = "HTTP通信エラー！"
End If
line_cn = line_cn + 1
DoEvents
Loop
MsgBox "おしまい。", vbOKOnly + vbInformation, "おしまい"
End Sub
' リクエスト結果を解析する
Private Sub JSON_analyzer_api_openbd(jsn_inf, isbn_no, sht, l_cnt)
Dim chr_cnt
Dim kgr_cnt
Dim tmp_chr
Dim ii
Dim jsn_summary
Dim s_chr(3)
s_chr(0) = "summary" 'アイテム数
s_chr(1) = "title" '題名
s_chr(2) = "author" '作者
s_chr(3) = "pubdate" '出版日
chr_cnt = InStr(jsn_inf, s_chr(0))
jsn_summary = Right(jsn_inf, Len(jsn_inf) - chr_cnt - 6)
'対象項目を検索するループ
For ii = 1 To 3
chr_cnt = InStr(jsn_summary, s_chr(ii))
If chr_cnt > 0 Then
kgr_cnt = InStr(chr_cnt, jsn_summary, ",")
If kgr_cnt = 0 Then
kgr_cnt = InStr(chr_cnt, jsn_summary, "}")
End If
tmp_chr = Mid(jsn_summary, chr_cnt, kgr_cnt - chr_cnt)
tmp_chr = Trim(Replace(Replace(Replace(Replace(Replace(Replace(tmp_chr, s_chr(ii), ""), """", ""), ":", ""), "[", ""), "]", ""), Chr(10), ""))
If ii = 0 Then
If tmp_chr = "0" Then
Worksheets(sht).Cells(l_cnt, 4).Value = "データ無！"
Exit Sub
End If
Else
Worksheets(sht).Cells(l_cnt, 3 + ii).Value = tmp_chr
End If
End If
Next
End Sub
'ISBN番号から、HTTPリクエストし、関連情報(JSON形式)取得
Private Function HTTP_REQ(isbn_no)
Dim httpReturn
Dim http_url
Dim tmp
Dim httpReq As XMLHTTP60
On Error GoTo Err_Handling
'openBD
http_url = "https://api.openbd.jp/v1/get?isbn=" & isbn_no
Set httpReq = New XMLHTTP60
httpReq.Open "GET", http_url
httpReq.Send
Do While httpReq.readyState < 4
DoEvents
Loop
httpReturn = httpReq.responseText
Set httpReq = Nothing
HTTP_REQ = httpReturn
Exit Function
Err_Handling:
Set httpReq = Nothing
HTTP_REQ = "ERR"
End Functionまとめ
実際にエクセルの定形様式を保管する際に困っていたので、利用できそうです。エクセルは比較的利用しますが、初めて知りました。