Skip to content

Instantly share code, notes, and snippets.

@nextdoorwith
Created December 20, 2020 02:45
Show Gist options
  • Save nextdoorwith/1f5fdc219df703690e6bc60a92aadc21 to your computer and use it in GitHub Desktop.
Save nextdoorwith/1f5fdc219df703690e6bc60a92aadc21 to your computer and use it in GitHub Desktop.
'======================================================================
' QRコード画像生成スクリプト
'
' - ExcelからAccessのBarcodeControlを使用してQRコードを生成します。
' - 実行には"Microsoft Office Access"、または"Access Runtime"が必要です。
'======================================================================
' 定数定義 ------------------------------------------------------------
'QRコードの縦・横幅
const QR_WIDTH = 300
'画像出力時の画像サイズ調整用の比率
'(作成される画像ファイルが上記の縦・横幅と異なる場合の調整用)
const SIZE_WEIGHT = 0.5
'処理途中の画像コピー&ペースト処理の失敗を抑制するための待機時間
const COPY_PASTE_INTERVAL = 1000 '[s]
'QRコード化する対象データ
const ENCODE_VALUE = "https://www.yahoo.co.jp"
' メイン処理 ----------------------------------------------------------
'Excelアプリを起動
Set App = CreateObject("Excel.Application")
'作業用のブック・シートを作成
Set TargetBook = app.Workbooks.Add
Set TargetSheet = TargetBook.Sheets(1)
'ワークシートにバーコードコントロールを追加
'(後のプロパティ設定でリサイズされてしまうので適当なサイズを指定)
Set OleObject = TargetSheet.OLEObjects.Add( _
"BARCODE.BarCodeCtrl.1", "", 1, 0, 0, 100, 100)
Set BarcodeObject = OleObject.Object
'プロパティ設定する前に非表示
'(QRコードがレンダリングされない問題の回避)
BarcodeObject.Visible = False
'QRコードの設定と表示
With BarcodeObject
.AutoLoad = True
.Style = 11
.Substyle = 0
.Validation = 1
.LineWeight = 3
.Direction = 0
.ShowData = 1
.ForeColor = 0
.BackColor = &H00FFFFFF
.Value = ENCODE_VALUE
.Refresh
End With
OleObject.Visible = True
'QRコードをコピー
WScript.Sleep COPY_PASTE_INTERVAL
BarcodeObject.CopyPicture
'画像をエクスポートするためのチャートを作成
'(チャートの挿入場所は適当な場所を指定)
WScript.Sleep COPY_PASTE_INTERVAL
TmpChartWidth = QR_WIDTH * SIZE_WEIGHT
Set TmpChart = TargetSheet.ChartObjects.Add( _
300, 0, TmpChartWidth, TmpChartWidth)
'チャートの枠線の出力を抑制
TmpChart.Chart.ChartArea.Format.Line.Visible = False
'QRコードをチャートに張り付け
TmpChart.Chart.Paste
'Excel上での上記処理結果を確認したい場合は有効化
'MsgBox "pause for debugging..."
'QRコードをファイルにエクスポート
ScriptPath = WScript.ScriptFullName
WorkFolder = Left(ScriptPath, InStrRev(ScriptPath, "\"))
'拡張子でエクスポートファイル形式を自動判別、上書き保存
TmpChart.Chart.Export WorkFolder & "qrcode-output.png"
'Excel終了(作成したブックは不要なので保存しない)
TargetBook.Close False
App.Quit
Sign up for free to join this conversation on GitHub. Already have an account? Sign in to comment