{"id":6743,"date":"2016-02-26T15:17:59","date_gmt":"2016-02-26T06:17:59","guid":{"rendered":"http:\/\/www.ka-net.org\/blog\/?p=6743"},"modified":"2016-02-26T15:17:59","modified_gmt":"2016-02-26T06:17:59","slug":"google-charts-api%e3%82%92%e4%bd%bf%e3%81%a3%e3%81%a6qr%e3%82%b3%e3%83%bc%e3%83%89%e3%81%ae%e7%94%bb%e5%83%8f%e3%82%92%e5%8f%96%e5%be%97%e3%81%99%e3%82%8bvba%e3%83%9e%e3%82%af%e3%83%ad","status":"publish","type":"post","link":"https:\/\/www.ka-net.org\/blog\/?p=6743","title":{"rendered":"Google Charts API\u3092\u4f7f\u3063\u3066QR\u30b3\u30fc\u30c9\u306e\u753b\u50cf\u3092\u53d6\u5f97\u3059\u308bVBA\u30de\u30af\u30ed"},"content":{"rendered":"

\uff20IT<\/a>\u306e\u8a18\u4e8b\u306b\u300cTech TIPS\uff1aGoogle Chart API\u3092\u4f7f\u3063\u3066QR\u30b3\u30fc\u30c9\u3092\u4f5c\u308b<\/a>\u300d\u3068\u3044\u3046\u3082\u306e\u304c\u3042\u3063\u305f\u306e\u3067\u3001VBA\u304b\u3089\u5b9f\u884c\u3057\u3066\u307f\u307e\u3057\u305f\u3002
\n(\u7d30\u304b\u3044\u30d1\u30e9\u30e1\u30fc\u30bf\u30fc\u306f\u4e0a\u8a18\u8a18\u4e8b\u53c2\u7167)<\/p>\n

Option Explicit\r\n\r\nPublic Sub Sample()\r\n  Const png As String = "C:\\Test\\MyQR.png"\r\n  GetQRImage size:=200, _\r\n             data:="\u6f22\u5b57\u3072\u3089\u304c\u306a\u30ab\u30bf\u30ab\u30caabc", _\r\n             pngpath:=png, _\r\n             margin:=0\r\n  With CreateObject("Scripting.FileSystemObject")\r\n    If .FileExists(png) = True Then\r\n      If MsgBox("\u53d6\u5f97\u3057\u305f\u753b\u50cf\u30d5\u30a1\u30a4\u30eb\u3092\u958b\u304d\u307e\u3059\u304b\uff1f", vbYesNo) = vbYes Then\r\n        CreateObject("Shell.Application").ShellExecute png\r\n      End If\r\n    End If\r\n  End With\r\nEnd Sub\r\n\r\nPrivate Sub GetQRImage(ByVal size As Long, _\r\n                       ByVal data As String, _\r\n                       ByVal pngpath As String, _\r\n                       Optional ByVal code As String = "UTF-8", _\r\n                       Optional ByVal errlevel As String = "L", _\r\n                       Optional ByVal margin As Long = 4)\r\n'Google Chart API\u3092\u4f7f\u3063\u3066QR\u30b3\u30fc\u30c9\u3092PNG\u753b\u50cf\u3068\u3057\u3066\u53d6\u5f97\r\n'\u203b URL\u30a8\u30f3\u30b3\u30fc\u30c9\u51e6\u7406\u306bScriptControl\u3092\u4f7f\u3063\u3066\u3044\u308b\u305f\u308132\u30d3\u30c3\u30c8\u7248Office\u306e\u307f\u5229\u7528\u53ef\u80fd\r\n'https:\/\/developers.google.com\/chart\/infographics\/docs\/qr_codes\r\n'https:\/\/google-developers.appspot.com\/chart\/infographics\/docs\/post_requests\r\n'http:\/\/www.atmarkit.co.jp\/ait\/articles\/1602\/26\/news037.html\r\n  Dim url As String\r\n  Dim body As Variant\r\n  Dim dat As Variant\r\n  Const adTypeBinary = 1\r\n  Const adSaveCreateOverWrite = 2\r\n  \r\n  url = "https:\/\/chart.googleapis.com\/chart"\r\n  dat = "cht=qr&chs=" & size & "x" & size & _\r\n        "&chl=" & EncodeURL(data) & _\r\n        "&choe=" & code & _\r\n        "&chld=" & errlevel & "|" & margin\r\n  On Error Resume Next\r\n  With CreateObject("WinHttp.WinHttpRequest.5.1")\r\n    .Open "POST", url, False\r\n    .SetRequestHeader "Content-Type", "application\/x-www-form-urlencoded; charset=UTF-8"\r\n    .Send dat\r\n    Select Case .Status\r\n      Case 200\r\n        body = .ResponseBody\r\n        With CreateObject("ADODB.Stream")\r\n          .Type = adTypeBinary\r\n          .Open\r\n          .Write body\r\n          .SaveToFile pngpath, adSaveCreateOverWrite\r\n          .Close\r\n        End With\r\n    End Select\r\n  End With\r\n  If Err.Number <> 0 Then\r\n    MsgBox "\u30a8\u30e9\u30fc\u304c\u767a\u751f\u3057\u307e\u3057\u305f\u3002" & vbNewLine & _\r\n           "\u30a8\u30e9\u30fc\u5185\u5bb9\uff1a" & Err.Description, _\r\n           vbCritical + vbSystemModal, _\r\n           "\u30a8\u30e9\u30fc\u756a\u53f7\uff1a" & Err.Number\r\n  End If\r\n  On Error GoTo 0\r\nEnd Sub\r\n\r\nPrivate Function EncodeURL(ByVal str As String) As String\r\n  With CreateObject("ScriptControl")\r\n    .Language = "JScript"\r\n    EncodeURL = .CodeObject.encodeURIComponent(str)\r\n  End With\r\nEnd Function<\/pre>\n
\uff20IT\u306e\u8a18\u4e8b\u3068\u9055\u3063\u3066POST\u3067\u51e6\u7406\u3057\u3066\u3044\u307e\u3059\u304c\u3001\u3084\u308a\u65b9\u306f\u540c\u3058\u3067\u3059\u3002
\n\u7c21\u5358\u306bQR\u753b\u50cf\u3092\u53d6\u5f97\u3067\u304d\u308b\u306e\u3067\u3001\u306a\u304b\u306a\u304b\u4fbf\u5229\u3060\u3068\u601d\u3044\u307e\u3059\u3002<\/p>\n","protected":false},"excerpt":{"rendered":"\uff20IT\u306e\u8a18\u4e8b\u306b\u300cTech TIPS\uff1aGoogle Chart API\u3092\u4f7f\u3063\u3066QR\u30b3\u30fc\u30c9\u3092\u4f5c\u308b\u300d\u3068\u3044\u3046\u3082\u306e\u304c\u3042\u3063\u305f\u306e\u3067\u3001VBA\u304b\u3089\u5b9f\u884c\u3057\u3066\u307f\u307e\u3057\u305f\u3002 (\u7d30\u304b\u3044\u30d1\u30e9\u30e1\u30fc\u30bf\u30fc\u306f\u4e0a\u8a18\u8a18\u4e8b\u53c2\u7167) Option Explicit P […]","protected":false},"author":1,"featured_media":7111,"comment_status":"open","ping_status":"closed","sticky":false,"template":"","format":"standard","meta":{"_jetpack_newsletter_access":"","_jetpack_dont_email_post_to_subs":false,"_jetpack_newsletter_tier_id":0,"_jetpack_memberships_contains_paywalled_content":false,"_jetpack_feature_clip_id":0,"_jetpack_memberships_contains_paid_content":false,"footnotes":"","jetpack_publicize_message":"[Google Charts API\u3092\u4f7f\u3063\u3066QR\u30b3\u30fc\u30c9\u306e\u753b\u50cf\u3092\u53d6\u5f97\u3059\u308bVBA\u30de\u30af\u30ed]","jetpack_publicize_feature_enabled":true,"jetpack_social_post_already_shared":true,"jetpack_social_options":{"image_generator_settings":{"template":"highway","default_image_id":0,"font":"","enabled":false},"version":2},"jetpack_post_was_ever_published":false},"categories":[4,48,49,58,126],"tags":[],"class_list":["post-6743","post","type-post","status-publish","format-standard","has-post-thumbnail","hentry","category-office","category-excel-office","category-word-office","category-powerpoint","category-google"],"aioseo_notices":[],"aioseo_head":"\n\t\t\n\t\n\t\n\t\n\t\n\t\n\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t\n\t\t