@ITの記事に「Tech TIPS:Google Chart APIを使ってQRコードを作る」というものがあったので、VBAから実行してみました。
(細かいパラメーターは上記記事参照)
Option Explicit
Public Sub Sample()
Const png As String = "C:\Test\MyQR.png"
GetQRImage size:=200, _
data:="漢字ひらがなカタカナabc", _
pngpath:=png, _
margin:=0
With CreateObject("Scripting.FileSystemObject")
If .FileExists(png) = True Then
If MsgBox("取得した画像ファイルを開きますか?", vbYesNo) = vbYes Then
CreateObject("Shell.Application").ShellExecute png
End If
End If
End With
End Sub
Private Sub GetQRImage(ByVal size As Long, _
ByVal data As String, _
ByVal pngpath As String, _
Optional ByVal code As String = "UTF-8", _
Optional ByVal errlevel As String = "L", _
Optional ByVal margin As Long = 4)
'Google Chart APIを使ってQRコードをPNG画像として取得
'※ URLエンコード処理にScriptControlを使っているため32ビット版Officeのみ利用可能
'https://developers.google.com/chart/infographics/docs/qr_codes
'https://google-developers.appspot.com/chart/infographics/docs/post_requests
'http://www.atmarkit.co.jp/ait/articles/1602/26/news037.html
Dim url As String
Dim body As Variant
Dim dat As Variant
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
url = "https://chart.googleapis.com/chart"
dat = "cht=qr&chs=" & size & "x" & size & _
"&chl=" & EncodeURL(data) & _
"&choe=" & code & _
"&chld=" & errlevel & "|" & margin
On Error Resume Next
With CreateObject("WinHttp.WinHttpRequest.5.1")
.Open "POST", url, False
.SetRequestHeader "Content-Type", "application/x-www-form-urlencoded; charset=UTF-8"
.Send dat
Select Case .Status
Case 200
body = .ResponseBody
With CreateObject("ADODB.Stream")
.Type = adTypeBinary
.Open
.Write body
.SaveToFile pngpath, adSaveCreateOverWrite
.Close
End With
End Select
End With
If Err.Number <> 0 Then
MsgBox "エラーが発生しました。" & vbNewLine & _
"エラー内容:" & Err.Description, _
vbCritical + vbSystemModal, _
"エラー番号:" & Err.Number
End If
On Error GoTo 0
End Sub
Private Function EncodeURL(ByVal str As String) As String
With CreateObject("ScriptControl")
.Language = "JScript"
EncodeURL = .CodeObject.encodeURIComponent(str)
End With
End Function
@ITの記事と違ってPOSTで処理していますが、やり方は同じです。
簡単にQR画像を取得できるので、なかなか便利だと思います。



















この記事へのコメントはありません。