Making a Particular Cell in Every Row a Button With VBA

Hello fp:

Thanks very much for your help.

I presume that if I want to Hyperlink to "http://www.msn.com" I should add this as one of your calling parameters, as so your Set objButton code -

     Link:= "http://www.msn.com" _
     DisplayAsIcon:=False, _
     
     (etc.)

Again Kudos. I looked for a function like this hours without much success.

You get the prize my man.

Gordy

Hi Gordy,

Thanks for your grading.

Have you got the "Link" parameter to function in the way you intended?

You may like to try this approach:

Option Explicit

' ----------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21612553/Making-a-Particular-Cell-in-Every-Row-a-Button-With-VBA.html
' Making a Particular Cell in Every Row a Button With VBA
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 29 October 2005
' ----------------------------------------------------------------------------

Private Declare Function ShellExecute _
                     Lib "shell32.dll" _
                   Alias "ShellExecuteA" _
                  (ByVal hwnd As Long, _
                   ByVal lpOperation As String, _
                   ByVal lpFile As String, _
                   ByVal lpParameters As String, _
                   ByVal lpDirectory As String, _
                   ByVal nShowCmd As Long) As Long
Public Sub Add_Buttons_And_Click_Events()

' ----------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21612553/Making-a-Particular-Cell-in-Every-Row-a-Button-With-VBA.html
' Making a Particular Cell in Every Row a Button With VBA
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 29 October 2005
' ----------------------------------------------------------------------------

  Dim lngButton                                         As Long
  Dim objButton                                         As Object
  Dim objCell                                           As Range
  Dim objCodeModule                                     As Object
 
  For Each objCell In [J1:J3]                           ' or [J:J] for the entire column
 
      Set objButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
                                                 Link:=False, _
                                                 DisplayAsIcon:=False, _
                                                 Left:=objCell.Left, _
                                                 Top:=objCell.Top, _
                                                 Width:=objCell.Width, _
                                                 Height:=objCell.Height)
                                                 
     objButton.Object.Caption = "Button #" & CStr(objCell.Row)
     
     Set objButton = Nothing
     
  Next objCell
 
  Set objCodeModule = ActiveWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
 
  For lngButton = 1& To 3&
     
'     ActiveSheet.OLEObjects("CommandButton" & CStr(lngButton)).Object.Caption = "Button #" & CStr(lngButton)
           
      objCodeModule.InsertLines objCodeModule.CountOfLines + 1&, _
                                "Sub CommandButton" & CStr(lngButton) & "_Click()" & _
                                 vbCrLf & vbLf & _
                                "  Call blnShell_Execute(" & Chr$(34) & "http://NigelLee.info" & Chr$(34) & ")" & _
                                 vbCrLf & vbLf & _
                                "End Sub"

  Next lngButton
 
  Set objCodeModule = Nothing

End Sub
Public Function blnShell_Execute(ByVal strURL As String, _
                                 Optional ByVal strParameters As String = vbNullString, _
                                 Optional lngShow_Cmd As Long = vbNormalFocus) As Boolean

' ----------------------------------------------------------------------------
' Experts Exchange Question:
' Home \ All Topics \ Applications \ MS Office \ Excel
' https://www.experts-exchange.com/questions/21612553/Making-a-Particular-Cell-in-Every-Row-a-Button-With-VBA.html
' Making a Particular Cell in Every Row a Button With VBA
'
' Copyright (c) 2005 Clearlogic Concepts (UK) Limited
' N.Lee [ http://NigelLee.info ] - 29 October 2005
' ----------------------------------------------------------------------------

  Dim blnReturn                                         As Boolean
  Dim lngErr_Number                                     As Long
  Dim lngHandle                                         As Long
  Dim strErr_Description                                As String
 
  On Error GoTo Err_blnShell_Execute
 
  blnReturn = False
 
  lngHandle = ShellExecute(0&, vbNullString, strURL, strParameters, vbNullString, lngShow_Cmd)
 
  blnReturn = (lngHandle > 31&)
 
Exit_blnShell_Execute:

  On Error Resume Next
 
  blnShell_Execute = blnReturn
 
  Exit Function
 
Err_blnShell_Execute:

  lngErr_Number = Err.Number
  strErr_Description = Err.Description
 
  On Error Resume Next
 
  MsgBox "Error #" & CStr(lngErr_Number) & _
          vbCrLf & vbLf & _
          strErr_Description, _
          vbExclamation Or vbOKOnly, _
          ActiveWorkbook.Name

  blnReturn = False
 
  Resume Exit_blnShell_Execute
 
End Function



BFN,

fp.

Hello fp:

Many thanks. Much more than I ever expected.

Gordy

You're very welcome, Gordy.

Hope it was useful.

BFN,

fp.