製品の出荷伝票に、QRコードを印字する依頼を受けましたが、かなり難しい。
というのも、Ａ４用紙三枚組のタックシールに同じコードを貼らねばならない。
コード自体は、誰がオリジナルを作ったのか知りませんが、定番はあるようだ。
ただ、QRコード作成は一つで、それをセルに張り付けるシンプルなロジック。
そのコードを失敬して、新たにブックを開いてシートを二つ作ることにします。
ブックでは、先ずデータの書込みと印刷するシートに分けてデータを読み込み。
これは、CSVファイルなので、”Line Input ＃”の構文から読みだして書き込み。
そこにはQRコードのデータ列があり、このデータをQR生成に使うわけですな。
一方、生成コードのプロシージャをモジュールに貼り付けましたが問題が出た。
それは生成データの指定を、”xOleObjct.Object.Value ＝ 変数”にすると失敗。
最初のサンプル構文では、”123456789”のように「“」の引用符で囲んだものね。
普通なら、これを変数に置き換えてもよさそうですが、何か扱いが違うようだ。
結局、引用符で囲んだ部分まで表現できる変数のコードを付加してまずは解決。
次に、内容は同じでも三つQRコードを張り付得る処理は、手軽なループ処理。
ただし、後で削除が簡単にできるように、各々オブジェクトにIDを割り振った。
こうして、プロシージャが出来上がりましたが、削除するコードも必要で作成。
というわけで、参考になればよいのですが、QRコードに全角字は組み込めない。
QRコードは、2013以降のオフィスであれば作成できるのですが、全角字の対応はしていないという制約があり、どうしても組み込みたいのなら、アドインソフトでも購入するしかないなと思うのでした。
＜参考コード＞
Sub CreateQRCode() 'アクティブシートにQRコード生成・貼り付け
Dim ws As Worksheet, xOleObjct As OLEObject
Dim TopPosition As Double, LeftPosition As Double
Dim j As Long, k As Long, Str As String
Str = "" '引用符込みのQRデータを変数で作成
Str = Str & WorkSheets("Sheet2").Range("A1").Value 'セル値(QRデータ)
Str = Str & ""
For k = 1 To 3 'QRコード三個作成なので、ループは三回
Set ws = Worksheets("Sheet1") 'QRコード作成のシート指定
Set xOleObjct = ws.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
'OLEObjectオブジェクト作成
With xOleObjct.Object 'OLEObjectオブジェクトをQRコード化
.Style = 11 'QRコード(=11)を指定
.Value = Str 'データを指定
End With
If k = 1 Then j = 1 'QRコード貼り付け行番号取得
If k = 2 Then j = 4
If k = 3 Then j = 7
With ws.Range("A" & j) 'QRコードを表示させるセル位置を取得
TopPosition = .Top + 2 'セル枠に罫線があるれば、+1～2を足しずらす
LeftPosition = .Left + 2
End With
With xOleObjct 'QRコードのサイズ、位置、名前を指定
.Height = 38 '縦と横のサイズ（単位不明、手動で調整する）
.Width = 38
.Top = TopPosition '貼り付け位置は左上部
.Left = LeftPosition
If k = 1 Then .Name = "QRcode1" 'IDを割り振る
If k = 2 Then .Name = "QRcode2"
If k = 3 Then .Name = "QRcode3"
End With
Set xOleObjct = Nothing '後片付け
Next k
End Sub
Sub QRcodeDelete() 'アクティブシートを指定しQRコード削除
Worksheets("Sheet1").Activate
ActiveSheet.OLEObjects.Delete
End Sub
0 件のコメント:
コメントを投稿