QRコード作成マクロについて

Question

お世話になっております。

QRコードを使ってラベルを作ろうと思います。
QRコード単体を作成はできましたが、どのように連続で処理させればよいか悩んでいます。

やりたいこととしては、
A8セルの情報をQRコード化してD2に貼り付け
A15セルの情報をQRコード化してD9に貼り付け
A22セルの情報をQRコード化してD16に貼り付け
A29セルの情報をQRコード化してD23に貼り付け
A36セルの情報をQRコード化してD30に貼り付け
これを列を移動させて連続して処理させたいです。

下記に現状のコードを記載します。
Sub createQRCode()

    Dim ws As Worksheet
    Dim xObjOLE As OLEObject
   
    Dim topPosition As Double
    Dim leftPosition As Double
    
    Set ws = Worksheets("Sheet1")
    
    Set xObjOLE = ws.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
    
    With xObjOLE.Object
        'QRコード(=11)を指定
        .Style = 11
        .Value = Cells(8, 1).Value  
    End With
    
    With ws.Range("D2").MergeArea
        topPosition = .Top
        leftPosition = .Left
    End With
    
    With xObjOLE
        .Height = 19.5
        .Width = 49.5
        .Top = topPosition
        .Left = leftPosition
    End With
        
    Set xObjOLE = Nothing

End Sub


マクロに関して初心者で無知の為
お力添え頂ければ幸いです。
よろしくお願いいたします。

tatsumaru77 · Accepted Answer

元のcreateQRCodeに多少手を加えました。
以下のようにしてください。（QR5X5を呼び出してください）

Sub QR5X5()
    Dim wy As Long  '下方向へのブロック番号
    Dim wx As Long  '右方向へのブロック番号
    For wy = 1 To 5
        For wx = 1 To 5
            Call createQRCode(wy, wx)
        Next
    Next
End Sub
Sub createQRCode(wy As Long, wx As Long)
    Dim wrow1 As Long   '入力値行
    Dim wcol1 As Long   '入力値列
    Dim wrow2 As Long   'QRコード貼り付行
    Dim wcol2 As Long   'QRコード貼り付列
    wrow1 = 7 * (wy - 1) + 8
    wcol1 = 5 * (wx - 1) + 1
    wrow2 = 7 * (wy - 1) + 2
    wcol2 = 5 * (wx - 1) + 4
    Dim ws As Worksheet
    Dim xObjOLE As OLEObject

Dim topPosition As Double
    Dim leftPosition As Double

Set ws = Worksheets("Sheet1")

Set xObjOLE = ws.OLEObjects.Add("BARCODE.BarCodeCtrl.1")

With xObjOLE.Object
        'QRコード(=11)を指定
        .Style = 11
        .Value = Cells(wrow1, wcol1).Value
    End With

With ws.Cells(wrow2, wcol2).MergeArea
        topPosition = .Top
        leftPosition = .Left
    End With

With xObjOLE
        .Height = 19.5
        .Width = 49.5
        .Top = topPosition
        .Left = leftPosition
    End With

Set xObjOLE = Nothing

End Sub

fujillin · Answer

こんにちは

ご質問の文章に限ってよいのなら・・

単純に列挙してしまって、
For Each c in Range("A8,A15,A22,A29,A36")
　’対象の値を c.Value
　'貼り付け先を c.Offset(-6,3) にして処理
Next c
のようにしてループすれば終わると思いますけれど、添付の図を見ると対象範囲がもっと広そうな・・

範囲不定なら、まず処理対象の範囲を取得してから、その中で行を7行おき、列は5列おきにループするような構成にしておけば良いのではないでしょうか？
For rw=8 To maxRow Step 7
　For col = 1 To maxCol Step 5
　　’ 1件分の処理
　　' 処理対象セルは Cells(rw, col) になる
　Next col
Next rw
みたいな感じです。

めくりや · Answer

もしかして始めてVBAで組む人ですか？もしかして繰り返し処理を知らないですか？そういう基本的なことはVBAで検索すればやまほど初心者学習サイトが見つかりますが。

QRコード作成マクロについて

元のcreateQRCodeに多少手を加えました。

こんにちは

もしかして始めてVBAで組む人ですか？もしかして繰り返し処理を知らないですか？そういう基本的なことはVBAで検索すればやまほど初心者学習サイトが見つかりますが。

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング