Excel VBAでQRコードを生成したい

質問

下記のようなExcelファイルがあります。
（Webシステムからのダウンロードで作られる.xlsmのファイル）
このExcelを開くときに、各シートにB4セル（データ3）をもとにQRコードを生成したいです。

　　　A　　｜　B　　
1 　タイトル（AB結合）　QRコード（タイトルと同様のセル、タイトルの右側に配置）
2　項目名1　データ1
3　項目名2　データ2
4　項目名3　データ3
5　項目名4　データ4

・シートはダウンロードするデータ数によるため変動
・各シートに1つQRコードを生成

テンプレートを利用しダウンロードしているため、指定のセルにはもともと違う値が入っています・
ActiveXコントロールでは中身のデータが更新されない＆シート2枚目以降にQRコードが生成されなかったためマクロで作成したいのですが、
インターネットで調べると1シート内の連続生成のみで
シートごとの繰り返し方がわからなかったので投稿させていただきました。
ご教授よろしくお願い致します。

回答No.4

kkkkkm

コードにCellsやRangeがありますが
シートの指定がないので同一シートの場合には
Sh.Cells
Sh.Range
にしたほうがいいと思います。

また、最後の
Next s
の前に
Set Sh = Nothing
を入れたほうが無難です。

回答No.3

kkkkkm

> もともとActivesheetの記入がありましたが、どのように設定したらよいでしょうか

Selectの場合指定したシートがアクティブじゃないとエラーになります。そのせいでエラーになっているのだと思います。
Sh.OLEObjects.Add(ClassType以下略
の前に
Sh.Activate
を入れて下さい。

回答No.2

kkkkkm

> この部分で表示をしているだけなのでしょうか。

そうですね。

補足

ソースコード変更しました。
1シートでQRコードの出力が確認できたため、
1回目のご回答でいただいた
For i = 1 To Sheets.Count
Set Sh = Sheets(i)
を組み込みましたが、
Sh.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
Top:=.Top + 10, Left:=.Left + 10, Height:=.Height - 20, Width:=.Width - 20).Select

この部分で「型が一致しません」というエラーが出ます。
もともとActivesheetの記入がありましたが、どのように設定したらよいでしょうか。

【以下ソースコード全文】
Sub QR15_Sample()
'QRコード15mm×15mmサイズ

Dim Str_Code As Variant
Dim Start_Add, Col As String
Dim Row_Pos, Col_Num, LastRow, Count As Long
Dim QR_Data() As String
Dim i As Integer

'**QRコード化するCodeデータ読み込み**
For s = 1 To Sheets.Count
Set Sh = Sheets(s)

For Each Str_Code In Cells(4, "B")
'If Str_Code = "str_code" Then
Row_Pos = Str_Code.Row
Start_Add = Str_Code.Address(True, False)
Col = Left(Start_Add, InStr(Start_Add, "$") - 1)
Col_Num = Asc(Col) - 64 '列番号アルファベットを数値化
'LastRow = Cells(Rows.Count, Col_Num).End(xlUp).Row 'データ入力最終行
'Count = LastRow - Row_Pos 'データ数
'End If
Next

'ReDim QR_Data(1 To Count) As String
ReDim QR_Data(1) As String

'QRコードへのリンクセル設定用にデータ入力セルのアドレスを取得
'For i = 1 To Count
' QR_Data(i) = Cells(Row_Pos + i, Col_Num).Address(RowAbsolute:=False, ColumnAbsolute:=False)
'Next i
i = 1
QR_Data(i) = Cells(4, 2).Address(RowAbsolute:=False, ColumnAbsolute:=False)

'**QRコード貼付けセルのサイズ指定処理**

'このサイズ設定はQRコード化する内容により適宜調整
'Rows(Row_Pos + 1 & ":" & LastRow).RowHeight = 50
'Columns(Col_Num + 1).ColumnWidth = 10

'**QRコードコントロールプロパティ設定**

'プロパティについては以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/library/cc427149.aspx

Const QR_Style As Integer = 11
'スタイル
'0: UPC-A, 1: UPC-E, 2: JAN-13, 3: JAN-8, 4: Casecode, 5: NW-7,
'6: Code-39, 7: Code-128, 8: U.S. Postnet, 9: U.S. Postal FIM, 10: 郵便物の表示用途（日本）
'11: QRコード

Const QR_Substyle As Integer = 0
'サブスタイル (下記URL参照)
'http://msdn.microsoft.com/ja-jp/library/cc427156.aspx

Const QR_Validation As Integer = 2
'データの確認
'0: 確認無し, 1: 無効なら計算を補正, 2: 無効なら非表示
'Code39/NW-7の場合、「1」でスタート/ストップ文字(*)を自動的に追加

Const QR_LineWeight As Integer = 3
'線の太さ
'0: 極細線, 1:細線, 2:中細線, 3:標準, 4:中太線, 5: 太線, 6:極太線, 7:超極太線

Const QR_Direction As Integer = 0
'QRコードの表示方向
'0: 0度, 1: 90度, 2: 180度, 3: 270度　[0]が標準

Const QR_ShowData As Integer = 0
'データの表示
'0: 表示無し, 1:表示有り

Const QR_ForeColor As Long = rgbBlack
'前景色の指定

Const QR_BackColor As Long = rgbWhite
'背景色の指定

'rgbBlackなどの色定数は以下URLのMSDN参照
'https://msdn.microsoft.com/ja-jp/VBA/Excel-VBA/articles/xlrgbcolor-enumeration-excel

'**QRコード化の処理＊＊

Dim QR_OLE_Obj As OLEObject
Dim QR_Obj As BARCODELib.BarCodeCtrl

'For i = 1 To Count
'QRコードサイズ、及び貼り付ける位置の指定
'上で設定したセルサイズに対し、枠内中央とする為にTop/Leftは+5、Height/Widthは-10
With Cells(1, 2)
ActiveSheets.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1", Link:=False, DisplayAsIcon:=False, _
Top:=.Top + 10, Left:=.Left + 10, Height:=.Height - 20, Width:=.Width - 20).Select
End With

Set QR_OLE_Obj = Selection
Set QR_Obj = QR_OLE_Obj.Object

'QRコードにプロパティ設定
With QR_Obj
.Style = QR_Style
.SubStyle = QR_Substyle
.Validation = QR_Validation
.LineWeight = QR_LineWeight
.Direction = QR_Direction
.ShowData = QR_ShowData
.ForeColor = QR_ForeColor
.BackColor = QR_BackColor
.Refresh
End With

'リンクするセルアドレスを指定
With QR_OLE_Obj
.Visible = False
.LinkedCell = Range(QR_Data(i)).Address(RowAbsolute:=False, ColumnAbsolute:=False, _
ReferenceStyle:=Application.ReferenceStyle)
.Visible = True
End With
Next s
End Sub

回答No.1

kkkkkm

> シートごとの繰り返し方

シートが連続しているのでしたら
左から1番2番と数えて
たとえば1番目から最後まででしたら
For i = 1 To Sheets.Count
'Sheets(i)か
’Dim Sh As Worksheet
’で宣言して
’Set Sh = Sheets(i)
'などでシートを指定してシートに対する動作
Next

とかでしょうか。

補足

ご回答ありがとうございます。
インターネットで拾ったソースコードをもとに修正しておりますが
QRコード生成のところで躓いております。

Sub QRコードリンク先生成()

Dim i As Integer
Dim num As Integer
Dim size As String
Dim URL0 As String
Dim URL1 As String
Dim URL2 As String
Dim URL3 As String
Dim URL4 As String

Dim Sh As Worksheet

For i = 1 To Sheets.Count
Set Sh = Sheets(i)

URL4 = Sheets(i).Cells(4, 2)
URL0 = URL1 & URL2 & URL3 & URL4

Cells(1, 2).Select
Sheets(i).Pictures.Insert URL0
Rows(1).Select
Selection.RowHeight = 50

Next
End Sub

もとのソースを確認したところ、
Sheets(i).Pictures.Insert URL0の部分（Sheets("QRコード生成").Pictures.Insert URL0）で
QRコードが生成されておりますが上記を実行すると
「実行時エラー '1004'
PicturesクラスのInsertメソッドが失敗しました。」
というエラーメッセージが表示されます。

画像がないよということのようですが、元ソースではこれより前にQRコードを生成しており、
この部分で表示をしているだけなのでしょうか。

ご教授いただければ幸いです。