Add a button programmatically in VBA

[dickey_tg]

Hi,

My project need to build the new button(s) by row level and let user through the button to trigger the function from EXCEL to API server. For instance, Approve / Reject processes.

I have [2] problems on coding level.
[1] When I change the coding to [OnAction = withReviewProc(nHYPER_APP, i)], the function is work BUT is not trigger by user. The function is auto-run when I call other button/procedure cmdBTEnquiry_Click() to query the data from API.
[2] When I use coding [OnAction = "btn"], the auto-run function is stopped, good. But I have no the idea how to trigger the function [withReviewProc] via on generated button

** Source : Link **

Here is my code.

Private Sub cmdBTEnquiry_Click()
:
For Each item In JSONa("entry_list")
           :
           i = 7
            nHYPER_APP = "http://api.xyz.com/api/rest.php?method=setentries&input_type=JSON&response_type=JSON&rest_data={"module":"V3295","name_value_list":[{"id":"9eb47658zyxxxxx","review":"Approve"}]}"

            'Create button - Start
            Dim btn As Button
            Application.ScreenUpdating = False
            'ActiveSheet.Buttons.Delete
            Dim t As Range
            Set t = ActiveSheet.Range(Cells(i, 1), Cells(i, 1))
            Set btn = ActiveSheet.Buttons.Add(t.Left, t.Top, t.Width, t.Height)
           
            With btn
                '.OnAction = "btn"
                .OnAction = withReviewProc(nHYPER_APP, i)
                .Caption = "Approve"
                '.Caption = "Btn " & i
                .Name = "Btn" & i
            End With
            Application.ScreenUpdating = True
            'Create button - End

           i = i + 1
            :
            :
Next
:
End Sub

Remark : [nHYPER_APP] is generate by dynamic coding. Each row(s)/button(s) should be pass the unify id to API server and let API server to update the specified dataset.

Here is the function of withReviewProc

Function withReviewProc(ByVal myurl As String, ByVal nopos As Integer)
        Dim xmlhttp01 As New MSXML2.XMLHTTP60
        xmlhttp01.Open "post", myurl, False
        xmlhttp01.send
        nRLT02 = xmlhttp01.responseText
        Set JSONe = JsonConverter.ParseJson(nRLT02)
        def = JSONe("ids")(1)
        If Len(def) > 0 Then
            Worksheets("Approval_WB").Cells(nopos, "N").Value = "Updated:" & def
        Else
            Worksheets("Approval_WB").Cells(nopos, "N").Value = "Not match"
        End If
End Function

 

[dickey_tg]

If it's in a worksheet, then you need to include the codename of the worksheet in the OnAction, so it would be:

onactionstring01 = "'Sheet57.withReviewProc " & i & ", """ & nHYPER_APP & """'"

or put the routine in a normal module.

Same error to show.... sad ##

Just change the statement like this

:
onactionstring01 = "'Sheet57.withReviewProc " & i & ", """ & nHYPER_APP & """'"
:
With btn
.OnAction = onactionstring01
:

Any example for this --> or put the routine in a normal module.
No idea on VBA

By the way, any size limit (length) of [.OnAction]. I guess, the hyperlink is too long and interrupt for this.

 

[RoryA]

Your hyperlink doesn't appear to change for each button, so why do you need it as an argument anyway? (there's also no way the code you posted initially with that hyperlink could possibly work)

 

[dickey_tg]

Your hyperlink doesn't appear to change for each button, so why do you need it as an argument anyway? (there's also no way the code you posted initially with that hyperlink could possibly work)

Existing I through [2] sheets to submit / query the data. Both works for me. All relied on hyperlink + various parameters to control the API actions.
[Sheet A] Through one button [Active X] to submit the data to API server.
[Sheet B] Through one button [Active X] to query the data from API server.

Now they want to through the EXCEL to [Approve] / [REJECT] for change request to support daily operation.
So, I plan to through the dynamic button [Active X] to let them to complete the job.

 

[RoryA]

I have no idea what you meant by that but:
1. The code you posted originally would not even compile, let alone run.
2. You are not using Active X buttons, you are using Form ones.
3. There doesn't appear to be any need for the URL to be passed as an argument. If there is, I'd suggest you pass an index number instead, and have the called code choose the appropriate URL based on that.

 

[dickey_tg]

I have no idea what you meant by that but:
1. The code you posted originally would not even compile, let alone run.
2. You are not using Active X buttons, you are using Form ones.
3. There doesn't appear to be any need for the URL to be passed as an argument. If there is, I'd suggest you pass an index number instead, and have the called code choose the appropriate URL based on that.

Finally, solved the last question and through your idea to modify the coding. It works. Thanks.
[Routine process] -> [Sub PassParam(7, <Approve/Reject>)] -> [Function withReviewProc( 7, <Approve/Reject>)]

.OnAction = "'Sheet59.PassParam " & i & "," & """APPROVE""" & "'"
.OnAction = "'Sheet59.PassParam " & i & "," & """REJECT""" & "'"

But, I has the new questions for other process . How to reuse the array list values in function as same worksheet?
I get the error [Sub or function not defined] when I reuse the array-list value in function call.

Existing worksheet59 have a coding to generate the array list like this.

[Worksheet59 - Routine process]

        Dim nRecinfo_APP(), nRecinfo_REJ() As Variant
       nRecLoc = 1
        If n_NoOfRlt = 0 Or Len(n_NoOfRlt) = 0 Then
            ReDim nRecinfo_APP(1 To 3, 1 To 3)
            ReDim nRecinfo_REJ(1 To 3, 1 To 3)
            MsgBox "No [UnderReview] requests in this movement"
        Else
            ReDim nRecinfo_APP(1 To n_NoOfRlt, 1 To 3)
            ReDim nRecinfo_REJ(1 To n_NoOfRlt, 1 To 3)
        End If
        For Each item In JSONa("entry_list")
           :
            nRecinfo_APP(nRecLoc, 1) = nSYSID
            nRecinfo_APP(nRecLoc, 2) = nHYPER_APP
            nRecinfo_APP(nRecLoc, 3) = CStr(i)
            nRecLoc = nRecLoc + 1
           :
        Next

Now I want to reuse the array list in function at same worksheet [Worksheet59].

Public Function withReviewProc(ByVal nopos As Integer, ByVal rtnRLS As String)
       :
        If rtnRLS = "APPROVE" Then
            myurl = nRecinfo_APP(nopos_aa, 2)
            'myurl = Worksheets("Approval_Q3").Cells(nopos, "L").Value
        Else
            myurl = nRecinfo_REJ(nopos_aa, 2)
            'myurl = Worksheets("Approval_Q3").Cells(nopos, "M").Value
        End If
       :
End Function