Office関連

Google Charts APIを使ってQRコードの画像を取得するVBAマクロ

@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画像を取得できるので、なかなか便利だと思います。

オトカドール 3rdドリームをプレイしてきたよ(6)前のページ

2016年2月の人気記事次のページ

関連記事

  1. アイコン一覧

    Office 365アイコン(imageMso)一覧(O)

    Office 365のデスクトップ版Officeアプリケーション(Wo…

  2. Office関連

    コマンドマクロ一覧(Word 2013)

    Word 2013に組み込まれている「コマンドマクロ」のコマンド名、説…

  3. Office アドイン

    [Office用アプリ]コピー&ペースト用マニフェストファイル

    Office 用アプリを作るとき、過去に作ったアプリのマニフェストファ…

  4. Office関連

    Officeアプリケーションのバージョン情報ダイアログから情報を取得するVBScript

    自分の手間を減らすためのスクリプトシリーズ、今回はWordやExcel…

  5. Excel

    ヘッドレス ChromeをSeleniumBasicで動かしてみました。

    Chromeがヘッドレスモードに対応した頃、Seleniumで操作した…

  6. Office Scripts

    マクロの記録後に記録した操作をOffice スクリプトとしても保存できるようになりました。

    先日、Excelでマクロの記録操作を行ったところ、記録を終了した際に作…

コメント

  • コメント (0)

  • トラックバックは利用できません。

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

Time limit is exhausted. Please reload CAPTCHA.

※本ページはプロモーションが含まれています。

Translate

最近の記事

アーカイブ

PAGE TOP