(VBA)行ごとにあるボタンを押すと、その行にあるデータがIEに転記されるようにしたい。

Question

一行ごとにマクロボタンを設置して、ボタンをクリックするとその行にあるデータをIEへ転記するというVBAを作りました。
このボタンを2行目から30行目まで設置して、クリックするごとにその行のデータを転記するようにしたく、転記するための処理をFunctionプロシージャで作って、1つのボタンごとにCallで呼び出すようなVBAを作成したのですが、Callを数十個作成するのが非常に手間で、どうにかもっとシンプルなコードにできないかアドバイスを頂きたく質問させて頂きました。

Function tenki(ByVal a As Integer, ByVal d As Integer, ByVal e As Integer, ByVal f As Integer, ByVal g As Integer) As Integer

    Dim colSh As Object
    Dim win As Object
    Dim objIE As Object
    Set colSh = CreateObject("Shell.Application")
    
    '開いているすべてのウインドウに対して処理する
    For Each win In colSh.Windows

    On Error Resume Next 'Window取得エラー対策
    '開いているファイルの種類がHTMLなら処理を実行する
    If TypeName(win.document) <> "HTMLDocument" Then
    Else
    
        '開いているサイトのURLが下記だったら
        If win.LocationURL = "https://www.shopjapan.co.jp/shop/customer/entry" Then

            'このウインドウをobjIEとして指定する
            Set objIE = win

            objIE.document.getElementsByName("customerLastNameKana")(0).Value = Left(Range("D" & d).Value, 3)
            objIE.document.getElementsByName("customerFirstNameKana")(0).Value = Right(Range("D" & d).Value, 4)
            objIE.document.getElementsByName("address1")(0).Value = Mid(Range("E" & e).Value, 4)
            objIE.document.getElementsByName("address2")(0).Value = Range("F" & f).Value
            objIE.document.getElementsByName("address3")(0).Value = Range("G" & g).Value
            
            '都道府県コードをAddressへ代入
            Dim Address As Object
            Dim Addresses As Object
            Set Addresses = objIE.document.getElementById("todofukenCd")

            'リスト項目名で選択 E列にある都道府県名を選択
            For Each Address In Addresses.getElementsByTagName("option")
                If Address.innerText = Left(Range("E" & e).Value, 3) Then
                    Address.Selected = True
                End If
            Next

            '処理を中断してFor~Nextを終了する
            Exit For
            
        End If
        
    End If
    
    On Error GoTo 0
    
    Next
    
    'ウインドウが見つからなければ
    If objIE Is Nothing Then
    
        'メッセージを表示して
         MsgBox "入力するページが見つかりません"
    
        '処理を終了する
        Exit Function
    
    End If
    
    Range("A" & a).Interior.Color = RGB(255, 0, 0)
End Function
Sub 転記1()
    Dim a As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    
    a = 2
    d = 2
    e = 2
    f = 2
    g = 2
    
    Call tenki(a, d, e, f, g)
    
End Sub
Sub 転記2()
    Dim a As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    
    a = 3
    d = 3
    e = 3
    f = 3
    g = 3
    
    Call tenki(a, d, e, f, g)
    
End Sub
Sub 転記3()
    Dim a As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    
    a = 4
    d = 4
    e = 4
    f = 4
    g = 4
    
    Call tenki(a, d, e, f, g)

以上になります。
お忙しいところ恐縮ですが、何卒よろしくお願い申し上げます。

Answer 1

そのボタンはフォームコントロールでしょうか。ActiveXコントロールでしょうか。

フォームコントロールなら、関連付けるマクロを共通にできます。
Application.Caller でどのボタンが押されたか判断できますので、それで処理を分けることが可能です。

ActiveXコントロールだとクラスモジュールを使って、イベントプロシージャを共通化します。

フォームコントロールの方かシンプルなので、そちらで回答します。

まず、ボタンの名前を btn_2, btn_3, ・・・btn_30 と規則的なものに変更します。
btn_ の後に転記したい行番号を続けます。

下記のマクロを作成して、これを各ボタンと関連付けます。

Sub 転記()
    Dim a As Integer
    
    a = Val(Mid(Application.Caller,5))

    Call tenki(a, a, a, a, a)

End Sub

以上です。

Comments

[js_boy]

ご回答ありがとうございます。
クリックごとに転記することができました！
しかし転記する行が一つズレてしまいます。
（btn_ の後に転記したい行番号の記載はしました。）
例えば、3行目にあるボタンをクリックすると、2行目が転記されてしまいます。
3行目にあるボタンをクリックすると3行目のデータが転記されるようにできないでしょうか？

[hatena19]

ボタン名の行番号が正しいならそうならないとは思いますが、
とりあえす、+1するとどうなりますか。

a = Val(Mid(Application.Caller,5)) + 1

[js_boy]

ご回答ありがとうございます。
+1を追記したらうまくいきました。
しかし、これは修正前から起きていた現象なのですが、なぜか7行目以降のボタンをクリックすると、8行目先のデータを転記するようになってしまいます・・・。

（例）
7行目のボタンをクリック
↓
15行目のデータが転記される

[js_boy]

7行目のボタン名を「btn_7」から「btn_2」とかに変えても同じ現象が起きてしまいます。

[hatena19]

提示されているコードを見る限りはそのようなことが発生するとは思えません。

とりあえず、今回の質問の趣旨であるコードをシンプルにする（マクロの共通化）ということができているので、この質問は解決済みにして、「想定の行とは異なる行か転記される」点については別に新規に質問しなおしてください。その際には、現象を再現できるシート構成、コードを提示してください。

[js_boy]

ご返信ありがとうございます。
上記以外にも他にコードが入力されていますので、それが原因で不具合が起こっているのかもしれません。
この件については新規での質問投稿をしようと思います。
この度はご回答いただきまして、誠にありがとうございました。

[js_boy]

下記で今回の現象を質問しました。
https://teratail.com/questions/295633#reply-417633

Answer 2

規則性のある繰り返し処理は、For-Next構文　にて行えます。
IE操作のため、１秒程度の待ち時間も必要です。

Sub 転記一括()
    Dim a As Integer
    Dim d As Integer
    Dim e As Integer
    Dim f As Integer
    Dim g As Integer
    Dim Cnt As Integer 'ループカウンター

    For Cnt = 2 To 10
        a = Cnt
        d = Cnt
        e = Cnt
        f = Cnt
        g = Cnt
   
        Call tenki(a, d, e, f, g)

        '1000ミリ秒待つ
        Application.Wait [Now()] + 1000 / 86400000
    Next Cnt
End Sub

Comments

[js_boy]

ご回答ありがとうございます。
ご回答頂いた内容ですと、一つボタンをクリックすると全ての行のデータが次々と転記されてしまいます。
今回やりたいことはボタンをクリックしたらそのボタンがある行のみのデータを転記するという処理になります。
説明が不十分ですみません。

[TanakaHiroaki]

質問内容を誤解していました。