Adding event code to a Command Button on a worksheet 2

[Rissolo]

Hi,
I am having difficulty adding code to a commandbutton and wondered if anyone has a solution for how to do this.

Brief description:
I create a worksheet on an open workbook by code (from a remote xla). I add a button to that worksheet by code. I want to assign event code to that button, but the .OnAction command doesn't work.



'**********************************
Sub AddSheet()
Worksheets.Add
ActiveSheet.Name = "NewSheet"

'Add OLE commandbutton
Range("O1&quot.Select
ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=348.75, Top:=12, Width:=72, Height:=24) _
.Select
Selection.ShapeRange.IncrementLeft -5.25
Selection.ShapeRange.IncrementTop -9.75
Selection.Name = "cmdMoveValue"
'Selection.Caption = "Move Value"
'Copy activation code to worksheet
ActiveSheet.OLEObjects("cmdMoveValue&quot.OnAction "MoveValue"
Range("B4&quot.Select
End Sub

'**********************************
Sub MoveValue()
msgbox "The button works!", vbokonly, "Yahoo!"
End Sub

 

[IvanMoala]

OnAction is not a method of the ActiveX commandbutton control. You either have to add dynamically via code the actual coding to the Class = Sheet code OR use a Formas button like this.

Sub AddSheet()
    Worksheets.Add
    ActiveSheet.Name = "NewSheet"


    'Add OLE commandbutton
    Range("O1").Select
    ActiveSheet.Buttons.Add(294, 12.75, 73.5, 21).Select
    Selection.OnAction = "MoveValue"
    'ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
        , DisplayAsIcon:=False, Left:=348.75, Top:=12, Width:=72, Height:=24) _
        .Select
    Selection.ShapeRange.IncrementLeft -5.25
    Selection.ShapeRange.IncrementTop -9.75
    'Selection.Name = "cmdMoveValue"
    'Selection.Caption = "Move Value"
    'Copy activation code to worksheet
    'ActiveSheet.OLEObjects("cmdMoveValue").OnAction "MoveValue"
    Range("B4").Select
End Sub

 

[Rissolo]

Thanks Ivan - That looks like it will do the trick!

As a separate but related question, do you know of a way to write code from one vba project to another? I work with a lot of .xla's to process .xls and .txt files in my work, and some of the data processing can get fairly complicated. Usually I have to transfer the data from one workbook to another in order to calculate the results.
If there were a way to write the event code and subroutines directly into the original data file, it would make my life a bit easier (and satisfy my curiosity for a few days).

Do you know how to do something like this - for example, writing a Worksheet_BeforeDoubleClick subroutine by code?

 

[Zathras]

The object you need to work with is a CodeModule

See the help file. You might start with this code snippet and build on it. (Take a look at the various Methods available for working with a CodeModule):
[blue]

Sub CountLines()
Dim WorkbookCodeModule As CodeModule
Dim TheBook As Workbook
  Set TheBook = Workbooks("Book1")
  Set WorkbookCodeModule = TheBook.VBProject.VBComponents("Sheet1").CodeModule
  MsgBox WorkbookCodeModule.CountOfLines
  Set TheBook = Nothing
  Set WorkbookCodeModule = Nothing
End Sub

[/color]

 

[IvanMoala]

Have a look @ this example, since you asked for a double click code.....

Option Explicit

Sub CreateSheet_DblCk_Event()
    '' Add a new sheet
    Add_Sheet
    '' Add double click Event
    Add_DblClick_To_CodeMod
End Sub

Sub Add_Sheet()

On Error Resume Next
Tryagain:
Sheets.Add
If Err <> 0 Then
    Application.DisplayAlerts = False
    ActiveSheet.Delete
    GoTo Tryagain
End If
On Error GoTo 0

Application.EnableEvents = True

End Sub

Sub Add_DblClick_To_CodeMod()

Dim ModEvent As CodeModule    'Module to Modified
Dim dblLineNumber As Long     'Line number in module
Dim strSubName As String      'Event to change as text
Dim strProc As String         'Procedure string
Dim strEndSub As String       'End sub string
Dim strApos As String         'Apostrophe
Dim strTabs As String         'Tab
Dim strLF As String           'Line feed or carriage return
Dim objSheetCode   As Object  'Newsheet code name
Dim oWks As Worksheet

Set oWks = ActiveSheet
strApos = Chr(34)
strTabs = Chr(9)
strLF = Chr(13)
strEndSub = &quot;End Sub&quot;

'// Get Code name of sheet
Set objSheetCode = oWks.Parent.VBProject.VBComponents(oWks.CodeName).Properties(&quot;_CodeName&quot;)

'// Your Event Procedure OR SubRoutine
strSubName = &quot;Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Excel.Range,&quot; _
    & &quot;Cancel As Boolean)&quot; & strLF

'// Build your Procedure
strProc = &quot;If Range(&quot; & strApos & &quot;A1&quot; & strApos & &quot; ) = 1 Then&quot; & strLF
strProc = strProc & strTabs & &quot;MsgBox &quot; & strApos & &quot;Testing number =&quot; & strApos & _
    &quot;& Range(&quot; & strApos & &quot;A1&quot; & strApos & &quot;)&quot; & strLF
strProc = strProc & &quot;End If&quot; & strLF

'// Use ThisWorkbook so that it cannot Act on another workbook
Set ModEvent = ActiveWorkbook.VBProject.VBComponents(objSheetCode).CodeModule

With ModEvent
    dblLineNumber = .CountOfLines + 1
    .InsertLines dblLineNumber, strSubName & strProc & strEndSub
End With

End Sub

http://www.xcelfiles.com