I am trying to create an additional menu item for the "Project and Solutions Context Menus>Solution" menu. However, I wanted this context menu to appear ONLY when a certain solution was opened, otherwise I don't want it to show. I figured I could use the MACROS within the Visual Studio IDE. There are events that run on the opening of solutions & projects, etc.
My question is, can I create the Context Menu I want programatically, point it to the MACRO I want it to run, and then programatically attach it to the CONTEXT menu inside the IDE that I want to display it in?
I found this link to be very useful.
Inside the OnConnection method, I had this:
CommandBars cmdBars = (CommandBars)applicationObject.CommandBars;
CommandBar codeWindowCmdBar = cmdBars["Code Window"];
CommandBarPopup doxygenPopup = (CommandBarPopup)codeWindowCmdBar.Controls.Add(MsoControlType.msoControlPopup,
System.Reflection.Missing.Value,
System.Reflection.Missing.Value,
1,
true);
doxygenPopup.Caption = "Doxygen Commenting";
CommandBarControl mnuListItem = (CommandBarControl)doxygenPopup.Controls.Add(MsoControlType.msoControlButton,
System.Reflection.Missing.Value,
System.Reflection.Missing.Value,
1,
true);
mnuListItem.Caption = "Wrap as List Item";
mnuListItemHandler = (CommandBarEvents) applicationObject.Events.get_CommandBarEvents(mnuListItem);
mnuListItemHandler.Click += mnuListItemHandler_Click;
CommandBarControl mnuUnorderedList = (CommandBarControl)doxygenPopup.Controls.Add(MsoControlType.msoControlButton,
System.Reflection.Missing.Value,
System.Reflection.Missing.Value,
2,
true);
mnuUnorderedList.Caption = "Wrap as Unordered List";
mnuUnorderedListHandler = (CommandBarEvents)applicationObject.Events.get_CommandBarEvents(mnuListItem);
mnuUnorderedListHandler.Click += mnuUnorderedListHandler_Click;
CommandBarControl mnuOrderedList = (CommandBarControl)doxygenPopup.Controls.Add(MsoControlType.msoControlButton,
System.Reflection.Missing.Value,
System.Reflection.Missing.Value,
2,
true);
mnuOrderedList.Caption = "Wrap as Ordered List";
mnuOrderedListHandler = (CommandBarEvents)applicationObject.Events.get_CommandBarEvents(mnuListItem);
mnuOrderedListHandler.Click += mnuOrderedListHandler_Click;
Inside the click event handlers I did whatever was needed.
Please not that this was for a main menu item with sub items. For just a single item, check out this video. The guy goes step by step... Very well done.
You can use DTE.ExecuteCommand() to execute other macros.
I found the answer to my question. I used the following code to create the menu items I needed:
Private WithEvents _objSolutionExplorer_ContextMenu_ItemHandler As EnvDTE.CommandBarEvents
Private _objHash_ContextMenuItemHandlers As New Hashtable
Private Function CreateContextMenuButtonItem(ByVal p_objMenuItem As Object, ByVal p_strMenuItemCaption As String) As CommandBarButton
'************************************************************************
' Procedure/Function: CreateContextMenuButtonItem()
' Author: Ben Santiago
' Created On: 08/18/2011
' Description:
' Creates specified MenuButton item.
'************************************************************************
'***************************************
' Initialize Variables
'***************************************
Dim objMenuButton As CommandBarButton
Dim objClickEventHandler As EnvDTE.CommandBarEvents
'***************************************
' If MenuItem Exists, Delete It
'***************************************
For intCounter As Integer = 1 To p_objMenuItem.Controls.Count
If p_objMenuItem.Controls.Item(intCounter).Caption = p_strMenuItemCaption Then
p_objMenuItem.Controls.Item(intCounter).Delete()
Exit For
End If
Next
If EnvironmentEvents._objHash_ContextMenuItemHandlers.Contains(p_strMenuItemCaption) Then
EnvironmentEvents._objHash_ContextMenuItemHandlers.Remove(p_strMenuItemCaption)
End If
'***************************************
' Create New Menu Item w/ Click Event Handling
'***************************************
objNewMenuItem = p_objMenuItem.Controls.Add(MsoControlType.msoControlButton, System.Reflection.Missing.Value, System.Reflection.Missing.Value, 1, True)
objNewMenuItem.Caption = p_strMenuItemCaption
objClickEventHandler = DTE.Events.CommandBarEvents(objNewMenuItem)
AddHandler objClickEventHandler.Click, AddressOf TestScoring_objSolutionExplorer_ContextMenu_ItemHandler_Click
If EnvironmentEvents._objHash_ContextMenuItemHandlers.Contains(p_strMenuItemCaption) Then
EnvironmentEvents._objHash_ContextMenuItemHandlers.Remove(p_strMenuItemCaption)
End If
EnvironmentEvents._objHash_ContextMenuItemHandlers.Add(p_strMenuItemCaption, objClickEventHandler)
'***************************************
' Return Reference To MenuButton Item
'***************************************
Return objNewMenuItem
End Function
Private Function CreateContextMenuPopupItem(ByVal p_strCommandBarName As String, ByVal p_strMenuCaption As String) As CommandBarPopup
'************************************************************************
' Procedure/Function: CreateContextMenuPopupItem()
' Author: Ben Santiago
' Created On: 08/18/2011
' Description:
' Creates specified MenuPopup item.
'************************************************************************
'***************************************
' Initialize Variables
'***************************************
Dim objCommandBar As CommandBar = DTE.CommandBars(p_strCommandBarName)
Dim objMenuPopup As CommandBarPopup
'***************************************
' Search For Existing ContextMenuPopup
'***************************************
For intCounter As Integer = 1 To objCommandBar.Controls.Count
If objCommandBar.Controls.Item(intCounter).Caption = p_strMenuCaption Then
objMenuPopup = objCommandBar.Controls.Item(intCounter)
Exit For
End If
Next
If objMenuPopup Is Nothing Then
'***************************************
' Create Menu If Needed
'***************************************
objMenuPopup = objCommandBar.Controls.Add(MsoControlType.msoControlPopup, System.Reflection.Missing.Value, System.Reflection.Missing.Value, 1, True)
objMenuPopup.Caption = p_strMenuCaption
Else
'***************************************
' Delete All Child Menu Items
'***************************************
For intCounter As Integer = objMenuPopup.Controls.Count To 1 Step -1
If EnvironmentEvents._objHash_ContextMenuItemHandlers.Contains(objMenuPopup.Controls.Item(intCounter).Caption) Then
EnvironmentEvents._objHash_ContextMenuItemHandlers.Remove(objMenuPopup.Controls.Item(intCounter).Caption)
End If
objMenuPopup.Controls.Item(intCounter).Delete()
Next
End If
'***************************************
' Return Reference To MenuPopup Item
'***************************************
Return objMenuPopup
End Function
Related
I found in StackOverflow some vb.net code written by "PaRiMaL RaJ". i want the same think but i must convert this code to work on VB6.
can you help me please???
Private Sub Form1_Load(ByVal sender As System.Object, ByVal e As System.EventArgs) Handles MyBase.Load
' creating control
Dim btn1 As Button = New Button()
Dim btn2 As Button = New Button()
btn1.Parent = Me
btn1.Name = "btn1"
btn1.Top = 10
btn1.Text = "Btn1"
btn2.Parent = Me
btn2.Name = "btn2"
btn2.Top = 50
btn2.Text = "Btn2"
'adding handler for click event
AddHandler btn1.Click, AddressOf HandleDynamicButtonClick
AddHandler btn2.Click, AddressOf HandleDynamicButtonClick
End Sub
Private Sub HandleDynamicButtonClick(ByVal sender As Object, ByVal e As EventArgs)
Dim btn As Button = DirectCast(sender, Button)
If btn.Name = "btn1" Then
MessageBox.Show("Btn1 clicked")
ElseIf btn.Name = "btn2" Then
MessageBox.Show("Btn2 Clicked")
End If
End Sub
The easiest way is to use a control array. Add a button to your form in the designer and set its Index property to 0. You can hide the button if you don't want it to be visible.
Then, when you want to dynamically add more buttons at run-time, just use the Load statement.
For example, if your button was named Command1:
Load Command1(1) ' Create a new button
Command1(1).Move 50, 50, 1500, 500 ' Set its size and position
Command1(1).Caption = "New Button" ' Give it a caption
Command1(1).Visible = True ' Make it visible
The button will use the same event handlers as your original button:
Private Sub Command1_Click(Index As Integer)
' Print the caption of the clicked button...
Debug.Print Command1(Index).Caption
End Sub
I'm brand new to ArcObjects SDKs and am struggling. I have a Python Add-in performing a query to select records (works great)and now trying to call the identify dialog via an .NET addin button that displays the identify dialog box to show attributes of the selected records. Below is the code I have at this point. I currently have the identify dialog displaying, but no records appearing. I know I need to input the selected records somewhere....but not sure where. Any thoughts would be appreciated. (I'm using Visual Studio/Microsoft Visual Basic 2010 and ArcGIS 10.2.1)
Imports ESRI.ArcGIS.ArcMapUI
Imports ESRI.ArcGIS.Carto
Public Class Identify_Button
Inherits ESRI.ArcGIS.Desktop.AddIns.Button
Dim pMxDoc As IMxDocument
Dim activeView As IMap
Public Sub DoIdentify(ByVal activeView As ESRI.ArcGIS.Carto.IActiveView, ByVal x As System.Int32, ByVal y As System.Int32)
pMxDoc = My.ArcMap.Application.Document
activeView = pMxDoc.FocusMap
If activeView Is Nothing Then
Return
End If
Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap
Dim identifyDialog As ESRI.ArcGIS.CartoUI.IIdentifyDialog = New ESRI.ArcGIS.CartoUI.IdentifyDialogClass
identifyDialog.Map = map
'Clear the dialog on each mouse click
identifyDialog.ClearLayers()
Dim screenDisplay As ESRI.ArcGIS.Display.IScreenDisplay = activeView.ScreenDisplay
Dim display As ESRI.ArcGIS.Display.IDisplay = screenDisplay ' Implicit Cast
identifyDialog.Display = display
Dim identifyDialogProps As ESRI.ArcGIS.CartoUI.IIdentifyDialogProps = CType(identifyDialog, ESRI.ArcGIS.CartoUI.IIdentifyDialogProps) ' Explicit Cast
Dim enumLayer As ESRI.ArcGIS.Carto.IEnumLayer = identifyDialogProps.Layers
enumLayer.Reset()
Dim layer As ESRI.ArcGIS.Carto.ILayer = enumLayer.Next
Do While Not (layer Is Nothing)
identifyDialog.AddLayerIdentifyPoint(layer, x, y)
layer = enumLayer.Next()
Loop
identifyDialog.Show()
End Sub
Public Sub New()
End Sub
Protected Overrides Sub OnClick()
DoIdentify(activeView, 300, 100)
End Sub
Protected Overrides Sub OnUpdate()
Enabled = My.ArcMap.Application IsNot Nothing
End Sub
End Class
Give the code below a try. This is executed from the OnClick event from an ArcMap command button that Inherits from BaseCommand. It displays the selected features in the map in the identifyDialog just as you were needing it to except I used AddLayerIdentifyOID() instead of AddLayerIdentifyPoint() although both should work.
Public Overrides Sub OnClick()
'VBTest.OnClick implementation
Try
Dim mxDoc As IMxDocument = m_application.Document
Dim map As ESRI.ArcGIS.Carto.IMap = mxDoc.FocusMap
Dim layer As ESRI.ArcGIS.Carto.ILayer
Dim flayer As ESRI.ArcGIS.Carto.IFeatureLayer
Dim featSelection As ESRI.ArcGIS.Carto.MapSelection = map.FeatureSelection
Dim feat As ESRI.ArcGIS.Geodatabase.IFeature = featSelection.Next()
Dim count As Int16 = 0
While feat IsNot Nothing
count += 1 ' flag for clearing layers
flayer = New ESRI.ArcGIS.Carto.FeatureLayer()
flayer.FeatureClass = feat.Class
layer = flayer
DoIdentify(layer, feat.OID, (count = 1))
feat = featSelection.Next()
End While
Catch ex As Exception
' handle error
MsgBox("Error: " + ex.Message)
End Try
End Sub
Private Sub DoIdentify(ByVal layer As ESRI.ArcGIS.Carto.ILayer, ByVal OID As Int32, Optional ByVal clearLayers As Boolean = True)
If layer Is Nothing Or OID <= 0 Then
Return
End If
Dim pMxDoc As IMxDocument = m_application.Document
Dim activeView As ESRI.ArcGIS.Carto.IActiveView = pMxDoc.ActiveView
Dim map As ESRI.ArcGIS.Carto.IMap = activeView.FocusMap
Dim identifyDialog As ESRI.ArcGIS.CartoUI.IIdentifyDialog = New ESRI.ArcGIS.CartoUI.IdentifyDialogClass()
Dim screenDisplay As ESRI.ArcGIS.Display.IScreenDisplay = activeView.ScreenDisplay
Dim display As ESRI.ArcGIS.Display.IDisplay = screenDisplay
identifyDialog.Map = map ' REQUIRED
identifyDialog.Display = display ' REQUIRED
' Clear the dialog
If clearLayers Then
identifyDialog.ClearLayers()
End If
' Add our selected feature to the dialog
identifyDialog.AddLayerIdentifyOID(layer, OID)
' Show the dialog
identifyDialog.Show()
End Sub
I have developed a custom MsgBox that works fine in almost every way. The only problem is that when the MsgBox closes the parent form runs the Form_Activate code. A normal MsgBox does not run that code (again).
I know i could add a boolean variable to Form_Activate to check if it has fired already, but that's not the best solution when you have a dozen forms.
So, is there a way to not run Form_Activate after closing my custom MsgBox? Does the MsgBox form need to be of some special type or something? I tried all BorderStyles but that doesn't make any difference.
Are you using another form to make custom MsgBox?
You shouldn't use directly other form to show a custom messagebox.
You should create an Activex control, and Activate event won't fire again when the MsgBox is closed.
Within the control you can use a form if you want it. (Probably just have to place your code inside an ActiveX control project and use it in your forms)
I use it that way.
This is a custom MsgBox example using Activex Control, with a test form too.
http://www.codeguru.com/code/legacy/vb_othctrl/2166_CustomMsgBox.zip
I created a Class for a Custom MsgBox.
Public Class CustomMsgBox
'Creates the Main form
Dim Main As New Form
'Creates the buttons
Dim Btn1, Btn2, Btn3 As New Button
'Creates the label
Dim Lbl As New Label
'Creates the Output variable
Dim Output As Integer = 0
Private Sub Load()
'Btn1 properties
Btn1.Location = New Point(168, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn2 properties
Btn2.Location = New Point(87, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Btn3 properties
Btn3.Location = New Point(6, 69)
Btn1.AutoSize = True
Btn1.AutoSizeMode = AutoSizeMode.GrowOnly
'Lbl properties
Lbl.Location = New Point(12, 19)
Lbl.AutoSize = True
Lbl.AutoEllipsis = True
'Main form properties
Main.Size = New Size(211, 129)
Main.AutoSize = True
Main.AutoSizeMode = AutoSizeMode.GrowOnly
Main.ShowIcon = False
Main.Controls.Add(Btn1)
Main.Controls.Add(Btn2)
Main.Controls.Add(Btn3)
Main.Controls.Add(Lbl)
'Adds Handlers to the buttons
AddHandler Btn1.Click, AddressOf btn1_Click
AddHandler Btn2.Click, AddressOf btn2_Click
AddHandler Btn3.Click, AddressOf btn3_Click
End Sub
Function CstMsgBox(ByRef Msg As String, ByRef Title As String, ByRef B1 As String, Optional ByRef B2 As String = Nothing, Optional ByRef B3 As String = Nothing) As Integer
'Runs the Load() Sub
Load()
'Sets the values
Lbl.Text = Msg
Btn1.Text = B1
Btn2.Text = B2
Btn3.Text = B3
Main.Text = Title
'Checks if there is a value set to Btn2 and Btn3
If Btn2.Text = Nothing Then
Btn2.Hide()
End If
If Btn3.Text = Nothing Then
Btn3.Hide()
End If
'Shows the MsgBox
Main.Show()
'Waits until a button is pressed
Do Until Output <> 0
Application.DoEvents()
Loop
'Closes the MsgBox
Main.Close()
Return Output
End Function
Private Sub btn1_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 1
Output = 1
End Sub
Private Sub btn2_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 2
Output = 2
End Sub
Private Sub btn3_Click(ByVal sender As Object, ByVal e As EventArgs)
'Sets the Output value to 3
Output = 3
End Sub
End Class
You can use it by typing this:
Dim CMB As New CustomMsgBox
CCMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
OR
Dim CMB As New CustomMsgBox
Select Case CMB.CstMsgBox('MSG, 'TITLE, 'BUTTON1, 'Optional: BUTTON2, 'Optional: BUTTON3)
Case 1
'Code to execute when button1 is pressed
Case 2
'Code to execute when button2 is pressed
Case 3
'Code to execute when button3 is pressed
End Select
How do I set SelectedIndex of a DataGridViewComboBoxCell?
The code fill the combobox with items, but I need to select one of them
My Code:
Dim cListItems As New System.Collections.Generic.List(Of Combobox_values)
If ds.Tables("items_prices").Rows(0).Item("item_selldozen") > 0 Then
Dim item_selldozen As String = ds.Tables("items_prices").Rows(0).Item("item_selldozen")
cListItems.Add(New Combobox_values("Docena (" + item_selldozen + ")", item_selldozen))
End If
Dim dgvcbc As DataGridViewComboBoxCell = DirectCast(CType(main.ActiveMdiChild, discount_new_discount).discountitems_new_discount.Rows(last_row).Cells(3), DataGridViewComboBoxCell)
dgvcbc.DataSource = cListItems 'Fill Remote Comboboxcell
dgvcbc.DisplayMember = "Text"
dgvcbc.ValueMember = "Value"
If you have a ComboBoxColumn in your DataGridView and you want to know what is the selected index of the combo box, then you need to do this:
Handle the EditingControlShowing event of DataGridView. In this event handler, check if the current column is of our interest. Then we
create a temporary ComboBox object and get the selected index:
Private Sub dataGridView1_EditingControlShowing(sender As Object, e As DataGridViewEditingControlShowingEventArgs)
If dataGridView1.CurrentCell.ColumnIndex = 0 Then
' Check box column
Dim comboBox As ComboBox = TryCast(e.Control, ComboBox)
comboBox.SelectedIndexChanged += New EventHandler(AddressOf comboBox_SelectedIndexChanged)
End If
End Sub
Private Sub comboBox_SelectedIndexChanged(sender As Object, e As EventArgs)
Dim selectedIndex As Integer = DirectCast(sender, ComboBox).SelectedIndex
MessageBox.Show("Selected Index = " & selectedIndex)
End Sub
I would like to add a Control and an associated event at runtime in Excel using VBA but I don't know how to add the events.
I tried the code below and the Button is correctly created in my userform but the associated click event that should display the hello message is not working.
Any advice/correction would be welcome.
Dim Butn As CommandButton
Set Butn = UserForm1.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With ThisWorkbook.VBProject.VBComponents("UserForm1.CommandButton1").CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
UserForm1.Show
The code for adding a button at runtime and then to add events is truly as simple as it is difficult to find out. I can say that because I have spent more time on this perplexity and got irritated more than in anything else I ever programmed.
Create a Userform and put in the following code:
Option Explicit
Dim ButArray() As New Class2
Private Sub UserForm_Initialize()
Dim ctlbut As MSForms.CommandButton
Dim butTop As Long, i As Long
'~~> Decide on the .Top for the 1st TextBox
butTop = 30
For i = 1 To 10
Set ctlbut = Me.Controls.Add("Forms.CommandButton.1", "butTest" & i)
'~~> Define the TextBox .Top and the .Left property here
ctlbut.Top = butTop: ctlbut.Left = 50
ctlbut.Caption = Cells(i, 7).Value
'~~> Increment the .Top for the next TextBox
butTop = butTop + 20
ReDim Preserve ButArray(1 To i)
Set ButArray(i).butEvents = ctlbut
Next
End Sub
Now you need to add a Class Module to your code for the project. Please remember it's class module, not Standard Module.
The Object butEvents is the button that was clicked.
Put in the following simple code (in my case the class name is Class2).
Public WithEvents butEvents As MSForms.CommandButton
Private Sub butEvents_click()
MsgBox "Hi Shrey from " & butEvents.Caption
End Sub
That's it. Now run it!
Try this:
Sub AddButtonAndShow()
Dim Butn As CommandButton
Dim Line As Long
Dim objForm As Object
Set objForm = ThisWorkbook.VBProject.VBComponents("UserForm1")
Set Butn = objForm.Designer.Controls.Add("Forms.CommandButton.1")
With Butn
.Name = "CommandButton1"
.Caption = "Click me to get the Hello Message"
.Width = 100
.Top = 10
End With
With objForm.CodeModule
Line = .CountOfLines
.InsertLines Line + 1, "Sub CommandButton1_Click()"
.InsertLines Line + 2, "MsgBox ""Hello!"""
.InsertLines Line + 3, "End Sub"
End With
VBA.UserForms.Add(objForm.Name).Show
End Sub
This permanently modifies UserForm1 (assuming you save your workbook). If you wanted a temporary userform, then add a new userform instead of setting it to UserForm1. You can then delete the form once you're done with it.
Chip Pearson has some great info about coding the VBE.
DaveShaw, thx for this code man!
I have used it for a togglebutton array (put a 'thumbnail-size' picture called trainer.jpg in the same folder as the excel file for a togglebutton with a picture in it). In the 'click' event the invoker is also available (by the object name as a string)
In the form:
Dim CreateTrainerToggleButtonArray() As New ToggleButtonClass
Private Sub CreateTrainerToggleButton(top As Integer, id As Integer)
Dim pathToPicture As String
pathToPicture = ThisWorkbook.Path & "\trainer.jpg"
Dim idString As String
idString = "TrainerToggleButton" & id
Dim cCont As MSForms.ToggleButton
Set cCont = Me.Controls.Add _
("Forms.ToggleButton.1")
With cCont
.Name = idString
.Width = 20
.Height = 20
.Left = 6
.top = top
.picture = LoadPicture(pathToPicture)
End With
ReDim Preserve CreateTrainerToggleButtonArray(1 To id)
Set CreateTrainerToggleButtonArray(id).ToggleButtonEvents = cCont
CreateTrainerToggleButtonArray(id).ObjectName = idString
End Sub
and a class "ToggleButtonClass"
Public WithEvents ToggleButtonEvents As MSForms.ToggleButton
Public ObjectName As String
Private Sub ToggleButtonEvents_click()
MsgBox "DaveShaw is the man... <3 from your friend: " & ObjectName
End Sub
Now just simple call from UserForm_Initialize
Private Sub UserForm_Initialize()
Dim index As Integer
For index = 1 To 10
Call CreateTrainerToggleButton(100 + (25 * index), index)
Next index
End Sub
This was my solution to add a commandbutton and code without using classes
It adds a reference to allow access to vbide
Adds the button
Then writes a function to handle the click event in the worksheet
Sub AddButton()
Call addref
Set rng = DestSh.Range("B" & x + 3)
'Set btn = DestSh.Buttons.Add(rng.Left, rng.Top, rng.Width, rng.Height)
Set myButton = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Left:=rng.Left, Top:=rng.Top, Height:=rng.Height * 3, Width:=rng.Width * 3)
DoEvents
With myButton
'.Placement = XlPlacement.xlFreeFloating
.Object.Caption = "Export"
.Name = "BtnExport"
.Object.PicturePosition = 1
.Object.Font.Size = 14
End With
Stop
myButton.Object.Picture = LoadPicture("F:\Finalised reports\Templates\Macros\evolution48.bmp")
Call CreateButtonEvent
End Sub
Sub addref()
On Error Resume Next
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files (x86)\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
Application.VBE.ActiveVBProject.References.AddFromFile "C:\Program Files\Common Files\Microsoft Shared\VBA\VBA6\VBE6EXT.OLB"
End Sub
Private Sub CreateButtonEvent()
On Error GoTo errtrap
Dim oXl As Application: Set oXl = Application
oXl.EnableEvents = False
oXl.DisplayAlerts = False
oXl.ScreenUpdating = False
oXl.VBE.MainWindow.Visible = False
Dim oWs As Worksheet
Dim oVBproj As VBIDE.VBProject
Dim oVBcomp As VBIDE.VBComponent
Dim oVBmod As VBIDE.CodeModule '
Dim lLine As Single
Const QUOTE As String = """"
Set oWs = Sheets("Contingency")
Set oVBproj = ThisWorkbook.VBProject
Set oVBcomp = oVBproj.VBComponents(oWs.CodeName)
Set oVBmod = oVBcomp.CodeModule
With oVBmod
lLine = .CreateEventProc("Click", "BtnExport") + 1
.InsertLines lLine, "Call CSVFile"
End With
oXl.EnableEvents = True
oXl.DisplayAlerts = True
Exit Sub
errtrap:
End Sub
An easy way to do it:
1 - Insert a class module and write this code:
Public WithEvents ChkEvents As MSForms.CommandButton
Private Sub ChkEvents_click()
MsgBox ("Click Event")
End Sub
2 - Insert a userform and write this code:
Dim Chk As New Clase1
Private Sub UserForm_Initialize()
Dim NewCheck As MSForms.CommandButton
Set NewCheck = Me.Controls.Add("Forms.CommandButton.1")
NewCheck.Caption = "Prueba"
Set Chk.ChkEvents = NewCheck
End Sub
Now show the form and click the button
I think the code needs to be added to the Userform, not to the button itself.
So something like
With UserForm1.CodeModule
'Insert code here
End With
In place of your With ThisWorkbook