Excel VBAでセル内の値を１づつ増やしながら部品カンバンを120枚作成

Question

Excelのワークシート１に１枚の部品カンバンを作成しました。
そのカンバン１枚のデザインはA1からD6までの範囲で作成。
A1のセルには　1036000102　という値が入っています。
A1セルの中にQRコードを配置し、QRコードはプロパティのLinkedCell欄をA1に設定しています。
D1セルにはシリアル№として　1　という値が入っています。
このカンバンをすぐ右に（2枚目はE1からH6、3枚目はI1からL6・・・となるように)120枚になるまでコピーしていきたいのですが、その際左上の　1036000102　という値を　1036000202　1036000302　というように3桁目を1づつ増やしたいです。最後は　1036012002　としたく。QRコードの
LinkedCellはE1、I1といった様にその値のセルになる様に。
又、D1のシリアル№も2、3、4、、、120となる様にVBAでどうにかなりませんか？
ご親切な方ご教示頂けないでしょうか？
よろしくお願い致します。

tatsumaru77 · Accepted Answer

A1:D6には添付図のように設定を行ってください。
以下のマクロで６６～１２０を生成します。

Sub QRCode作成65_120()
    Dim wcol As Long
    Dim wrow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim i As Long
    Dim wrg As String
    Dim xObjOLE As OLEObject
    Dim xObjOLEorg As OLEObject
    Set xObjOLEorg = ws.OLEObjects(1)
    Application.ScreenUpdating = False
    
    For i = 66 To 120
        wcol = (i - 65) * 4 + 1
        wrow = 1
        ws.Cells(1, wcol + 0).ColumnWidth = ws.Cells(1, 1).ColumnWidth
        ws.Cells(1, wcol + 1).ColumnWidth = ws.Cells(1, 2).ColumnWidth
        ws.Cells(1, wcol + 2).ColumnWidth = ws.Cells(1, 3).ColumnWidth
        ws.Cells(1, wcol + 3).ColumnWidth = ws.Cells(1, 4).ColumnWidth
        wrg = ws.Cells(1, wcol).Address(False, False)
        ws.Range("A1:D6").Copy Destination:=ws.Range(wrg)
        ws.Cells(1, wcol + 0).Value = ws.Cells(1, 1).Value + (i - 65) * 100
        ws.Cells(1, wcol + 3).Value = i
        Set xObjOLE = ws.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
        xObjOLE.Object.Style = 11
        With xObjOLE
            .LinkedCell = ws.Cells(1, wcol).Address(False, False)
            .Height = xObjOLEorg.Height
            .Width = xObjOLEorg.Width
            .Top = xObjOLEorg.Top
            .Left = ws.Cells(1, wcol + 0).Left + xObjOLEorg.Left
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox ("完了")
End Sub

tatsumaru77 · Answer

>今考えているのですが、頂いたコードで作成出来た64枚目を別のワークシートに貼り付けもう一度同じ作業を行えばとりあえずはやりたい事は出来るのかなと。

以下のようなことでしょうか。

現在、1～６４までは、作成できることはわかっているので、
今回、現在のシートの１～６４までを採用し、別のシートに
６５～１２０を作ることは、可能かと思います。
６５がA1：D6のセルになり、その右側に６６を作ります。
そのようにして、１２０まで作ります。
A1:D6のセルは、あなたの責任でQRコードと文字を設定します。
マクロで、６５～１２０の分を作成します。
上記で良ければ、マクロの提供は可能です。

>やはりそのbookを見て頂かないとわからないですかね。
こちらで、エラーが再現できないと対処のしようがないです。
ちなみに、「実行時エラー1004　アプリケーション定義またはオブジェクト定義のエラー」となったとき、ほかにエラー番号のようなものは出力されませんでしたか。また、マクロのどの行で止まったかは、わかりますでしょうか。
上記のエラー番号等を手掛かりに、ネットを検索すると、もしかしたら、対処の方法がわかるかもしれません。
（わからない可能性が高いですが・・・）

tatsumaru77 · Answer

No6の追伸です。
ファイルをアップする際、
①QRコードが１個のシート（マクロ実行前のシート）
②マクロを実行してエラーになったシート
の２シートを載せてください。
特に①は必須になります。

tatsumaru77 · Answer

For i = 65 To 120がだめだった場合です。
ファイルのアップロードはOKと理解しました。
以下の手順で行ってください。

１．下記の無料のオンラインストレージサイトで行ってください。
（会員登録をしなくてもアップ可能です）

https://firestorage.jp/

２．上記のサイトに、excelをアップしてください。

３．アップする前にexcelファイルの個人情報をすべて削除してください。
添付図のように、excelファイルを選択し、右クリックし、「プロパティ」を選択します。
プロパティの画面が表示されるので、「詳細」タブをクリックすると、「プロパティや個人情報を削除」
のガイドが表示されるので（赤線で囲んだところ）、それをクリックします。
あとは、表示されるメッセージに従って削除してください。

４．こちらのサンプルを上記のサイトアップしました。
パスワード:goo
7日間保存されます。
https://firestorage.jp/download/e206176916e3092e3bb9d8daf4ac1cf99635e104
にアップしてあります。ダウンロードしてみてください。

tatsumaru77 · Answer

>家のPCはwindows8.1 excelは2013home and business 64ビットです。
>このバージョンではQRは作成出来ないんですかね、、、。

excel2016以上でないとQRコードは作成できません。あきらめてください。

>明日For i = 65 To 120 を入れてみて確認してます。
これで、OKなら問題ないですが、ダメだった場合の対策です。
このエラーをこちらでは、再現できないので、こちらではそれ以上はできません。したがって、以下の案は可能ですか。

案：
エラーが発生する、そのブックをどこかの公開されているサイトにアップする。（当然、会社情報がある場合は適度に○○などの伏字にします）
そのブックを私がダウンロードし、こちらで動作確認する。

tatsumaru77 · Answer

本件のエラーは、環境の違いによる可能性が高いです。

１．もし、実行されたのが家のPCでなら、会社のPCで実行して、その結果をお知らせください。（投稿時間をみると自宅から投稿したように思われます）。実行したのが、会社のPCなら、この回答は無視して項番２へ進んでください。

２．６４枚までできているということは、IS1のセルに正しくQRコードが設定されていると理解しました。
もし、IW1のセルにQRコードの残骸があるならそれをまず削除してください。削除したのち、
マクロの
    For i = 2 To 120
を
    For i = 65 To 120
に変えてください。
そうすれば、６５枚目から作り直します。
なお、６５枚目の残骸がのこった状態でじっこうすると、２つQRコードが
つくられるので、かならず、残骸を削除してから実行してください。

３．参考までに、実行したPCの環境を教えていただけませんでしょうか。
ちなみに、こちらの環境ですが、
①OSはWindows10 Pro. 64ビット版
②ExcelはOfiice Home and Business 2019の 32ビット版
です。

tatsumaru77 · Answer

以下のマクロを標準モジュールに登録してください。
表示されているシートが実行対象になります。
一発勝負なので、実行前に当該シートのバックアップをとってから行ってください。（もしくは当該ブックのバックアップ）

Option Explicit
Sub QRCode作成120()
    Dim wcol As Long
    Dim wrow As Long
    Dim ws As Worksheet
    Set ws = ActiveSheet
    Dim i As Long
    Dim wrg As String
    Dim xObjOLE As OLEObject
    Dim xObjOLEorg As OLEObject
    Set xObjOLEorg = ws.OLEObjects(1)
    Application.ScreenUpdating = False
    
    For i = 2 To 120
        wcol = (i - 1) * 4 + 1
        wrow = 1
        ws.Cells(1, wcol + 0).ColumnWidth = ws.Cells(1, 1).ColumnWidth
        ws.Cells(1, wcol + 1).ColumnWidth = ws.Cells(1, 2).ColumnWidth
        ws.Cells(1, wcol + 2).ColumnWidth = ws.Cells(1, 3).ColumnWidth
        ws.Cells(1, wcol + 3).ColumnWidth = ws.Cells(1, 4).ColumnWidth
        wrg = ws.Cells(1, wcol).Address(False, False)
        ws.Range("A1:D6").Copy Destination:=ws.Range(wrg)
        ws.Cells(1, wcol + 0).Value = ws.Cells(1, 1).Value + (i - 1) * 100
        ws.Cells(1, wcol + 3).Value = i
        Set xObjOLE = ws.OLEObjects.Add("BARCODE.BarCodeCtrl.1")
        xObjOLE.Object.Style = 11
        With xObjOLE
            .LinkedCell = ws.Cells(1, wcol).Address(False, False)
            .Height = xObjOLEorg.Height
            .Width = xObjOLEorg.Width
            .Top = xObjOLEorg.Top
            .Left = ws.Cells(1, wcol + 0).Left + xObjOLEorg.Left
        End With
    Next
    Application.ScreenUpdating = True
    MsgBox ("完了")
End Sub

tatsumaru77 · Answer

補足ありがとうございました。
添付図のような感じでしょうか。
写メの結果を待ってから、マクロを提示したいと思います。

tatsumaru77 · Answer

補足要求です。
①A1のセルにQRコードを配置すると、その値(1036000102)がA1にありますが、
その1036000102の値は、QRコードと一緒にみえるようにしておく必要があるかと思います。
その為には、そのA1のセルの縦位置の配置を上詰めにしておく必要がありますが、あなたのもそのようになっていますか。それとも、それ以外の方法で、文字も見えるようにしているのでしょうか。その場合は、その方法も補足してください。
セルの縦位置の配置の上詰めについては添付図の赤線で囲んだボタンをクリックします。

②B,C,D列についても、セルの配置を変えていますか。それとも、そのままですか。

③A列の幅は、大きくなっているので、あなたが作成した、A,B,C,D列の幅を基準にして、それを
ほかの列（E,F,G,H列　　I,J,K,L列・・・）にも適用します。それでよろしいでしょうか。

④「カンバン１枚のデザインはA1からD6までの範囲で作成」ということですが、
２行目から６行目については、マクロでは関知しませんが、それでよいでしょうか。
A2～RL6のセルはあなたが、設定する箇所で、マクロでは何の設定もしないという意味です。

⑤念のため、祖語のないようにするために、A1～D6のセルの画像を提示していただけませんでしょうか。
画像が、アクセサリのSnipping Toolを使用すると簡単に画面から切り取りができます。
添付の画像もSnipping Toolを使用しています。

Excel VBAで セル内の値を１づつ増やしながら部品カンバンを120枚作成

A1:D6には添付図のように設定を行ってください。

>今考えているのですが、頂いたコードで作成出来た64枚目を別のワークシートに貼り付けもう一度同じ作業を行えばとりあえずはやりたい事は出来るのかなと。

No6の追伸です。

For i = 65 To 120がだめだった場合です。

>家のPCはwindows8.1 excelは2013home and business 64ビットです。

本件のエラーは、環境の違いによる可能性が高いです。

以下のマクロを標準モジュールに登録してください。

補足ありがとうございました。

補足要求です。

似たような質問が見つかりました

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

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

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

Excel VBAでセル内の値を１づつ増やしながら部品カンバンを120枚作成