I would like to do more or less as the author has intended here:
http://ccm.net/faq/1105-adding-a-vba-commandbutton-with-its-respective-the-code
unfortunately, although the code is written to the correct sheet in Microsoft Excel Objects, the code does not run once the button is pressed. The _Click() is here:
Sub ButtonTest_Click()
MsgBox "I am supposed to work!" 'but i dont, i actually do nothing
End Sub
and the rest of the code is below:
Sub CreateButton()
Dim Obj As Object
Dim Code As String
Sheets("Sheet1").Select
'create button
Set Obj = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False, Left:=200, Top:=100, Width:=100, Height:=35)
Obj.Name = "TestButton"
'buttonn text
ActiveSheet.OLEObjects(1).Object.Caption = "Test Button"
'macro text
Code = "Sub ButtonTest_Click()" & vbCrLf
Code = Code & "Msgbox ""I am supposed to work!""" & vbCrLf
Code = Code & "End Sub"
'add macro at the end of the sheet module
With ActiveWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
.insertlines .CountOfLines + 1, Code
end With
End Sub
nothing happens when the button is pressed- to my mind it looks like it should fire the event as author intended, any ideas why it doesn't?
You are creating ActiveX components. Unlike form components you cannot name the underlying macros as you wish. The macros' names must start with the name of the ActiveX component followed by and underscore and the even name.
So, if your ActiveX component is named TestButton (according to this):
Obj.Name = "TestButton"
Then the sub's name to handle the click event must be named:
Sub TestButton_Click()
Hence, you'll have to rename the sub or you must change the name for the ActiveX component to match.
Alternatively, you can also implement form controls. The following three lines of code create a new form control CheckBox and assigns your macro to it (when clicked):
Dim chk As CheckBox
Set chk = ActiveSheet.CheckBoxes.Add(390.75, 216, 72, 72)
chk.OnAction = "ButtonTest_Click"
Related
Is there any way to write a VBA Macro to input another VBA Macro into multiple excel workbooks? If so, how do I start?
Any and all help is greatly appreciated.
you'll need a reference first
Microsoft Visual Basic For Applications Extensibility 5.3
And here you go. Have fun
Public Sub AddNewModule()
Dim proj As VBIDE.VBProject
Dim comp As VBIDE.VBComponent
Set proj = ActiveWorkbook.VBProject
Set comp = proj.VBComponents.Add(vbext_ct_StdModule)
comp.Name = "MyNewModule"
Set codeMod = comp.CodeModule
With codeMod
lineNum = .CountOfLines + 1
.InsertLines lineNum, "Public Sub ANewSub()"
lineNum = lineNum + 1
.InsertLines lineNum, " MsgBox " & """" & "I added a module!" & """"
lineNum = lineNum + 1
.InsertLines lineNum, "End Sub"
End With
End Sub
You can also just use the workbook with the code in it as a reference as well. Then you can call the module remotely.
As #BruceWayne mentioned, there is also sotring it in the personal book.
tl;dr - there's a few options that can get you there.
I recommend storing them in the Personal.xslb file which is accessible across Excel.
See this page or this page for more detail, but generally a quick way to get started is:
Press ALT+F11 to open the VBEditor.
Right click the "VBAProject (PERSONAL.XLSB)" and Add a new module
Add your code in the module.
Now, when you go to View --> Macros, you can choose to see those stored in the Personal.xlsb file:
(I "whited out" my macros for privacy, but they'll be listed by name)
Note: If you do not have a "Personal.xlsb", then you must create it. Simply record a new macro, but choose to store it in "Personal Macro Workbook". Then you should see it in the VBEditor.
I would think the easiest way to have the same code in slightly different Excel files is to have one 'template' and save it several times as several slightly different files. Or, if you want to get fancy, you can create an AddIn to make an Excel Macro available to all workbooks.
Option Explicit
Dim cControl As CommandBarButton
Private Sub Workbook_AddinInstall()
On Error Resume Next 'Just in case
'Delete any existing menu item that may have been left.
Application.CommandBars("Worksheet Menu Bar").Controls("Super Code").Delete
'Add the new menu item and Set a CommandBarButton Variable to it
Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add
'Work with the Variable
With cControl
.Caption = "Super Code"
.Style = msoButtonCaption
.OnAction = "MyGreatMacro"
'Macro stored in a Standard Module
End With
On Error GoTo 0
End Sub
Private Sub Workbook_AddinUninstall()
On Error Resume Next 'In case it has already gone.
Application.CommandBars("Worksheet Menu Bar").Controls("Super Code").Delete
On Error GoTo 0
End Sub
This code will be all you need to add a single menu item (called Super Code) to the end of the existing Worksheet Menu Bar as soon as the Add-in is installed by the user via Tools>Add-ins. When the Super Code menu item is clicked a macro (that is within a standard module of the add-in) is run. As mentioned earlier, the above code MUST be placed in the Private Module of ThisWorkbook for the Add-in.
If you want the Super Code menu item added, say before the Format menu item, you could use some code like this.
Option Explicit
Dim cControl As CommandBarButton
Private Sub Workbook_AddinInstall()
Dim iContIndex As Integer
On Error Resume Next 'Just in case
'Delete any existing menu item that may have been left
Application.CommandBars("Worksheet Menu Bar").Controls("SuperCode").Delete
'Pass the Index of the "Format" menu item number to a Variable.
'Use the FindControl Method to find it's Index number. ID number _
is used in case of Customization
iContIndex = Application.CommandBars.FindControl(ID:=30006).Index
'Add the new menu item and Set a CommandBarButton Variable to it.
'Use the number passed to our Integer Variable to position it.
Set cControl = Application.CommandBars("Worksheet Menu Bar").Controls.Add(Before:=iContIndex)
'Work with the Variable
With cControl
.Caption = "Super Code"
.Style = msoButtonCaption
.OnAction = "MyGreatMacro"
'Macro stored in a Standard Module
End With
On Error GoTo 0
End Sub
There would be no need to change the Workbook_AddinUninstall() code in this case.
We have covered ID numbers while working with CommandBars etc in a P rior Newsletter Issue The link to the Microsoft site that has a BIG list of all the ID numbers for working with CommandBars can be Found Here
The above examples actually have the all the menu item code in the Workbook_AddinInstall and Workbook_AddinUnInstall Not a problem when the code is only adding one menu item. If however, you will be adding more then one and perhaps even Sub menus, you should place it in a Procedure (or 2) inside a standard Module. Then use some code as shown below
Private Sub Workbook_AddinInstall()
Run "AddMenus"
End Sub
Private Sub Workbook_AddinUninstall()
Run "DeleteMenu"
End Sub
Then in the standard module put some code perhaps like this
Sub AddMenus()
Dim cMenu1 As CommandBarControl
Dim cbMainMenuBar As CommandBar
Dim iHelpMenu As Integer
Dim cbcCutomMenu As CommandBarControl
'(1)Delete any existing one.We must use On Error Resume next _
in case it does not exist.
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&NewMenu").Delete
'(2)Set a CommandBar variable to Worksheet menu bar
Set cbMainMenuBar = Application.CommandBars("Worksheet Menu Bar")
'(3)Return the Index number of the Help menu. We can then use _
this to place a custom menu before.
iHelpMenu = cbMainMenuBar.Controls("Help").Index
'(4)Add a Control to the "Worksheet Menu Bar" before Help
'Set a CommandBarControl variable to it
Set cbcCutomMenu = cbMainMenuBar.Controls.Add(Type:=msoControlPopup, Before:=iHelpMenu)
'(5)Give the control a caption
cbcCutomMenu.Caption = "&New Menu"
'(6)Working with our new Control, add a sub control and _
give it a Caption and tell it which macro to run (OnAction).
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Menu 1"
.OnAction = "MyMacro1"
End With
'(6a)Add another sub control give it a Caption _
and tell it which macro to run (OnAction)
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "Menu 2"
.OnAction = "MyMacro2"
End With
'Repeat step "6a" for each menu item you want to add.
'Add another menu that will lead off to another menu
'Set a CommandBarControl variable to it
Set cbcCutomMenu = cbcCutomMenu.Controls.Add(Type:=msoControlPopup)
' Give the control a caption
cbcCutomMenu.Caption = "Next Menu"
'Add a control to the sub menu, just created above
With cbcCutomMenu.Controls.Add(Type:=msoControlButton)
.Caption = "&Charts"
.FaceId = 420
.OnAction = "MyMacro2"
End With
On Error GoTo 0
End Sub
Sub DeleteMenu()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls("&NewMenu").Delete
On Error GoTo 0
End Sub
You can find all details here.
http://www.ozgrid.com/VBA/excel-add-in-create.htm
I'm working on a spreadsheet with a Form Control that opens a Userform used for data entry purposes. The submit button of the form fills a row of cells and adds two buttons on the last two cells of the row. It will insert as many rows as the user does and each time the two new buttons are created with their own distinct name. However, these are ActiveX controls and they are giving me compatibility problems with other Windows/Office versions once colleagues open the file and try to use it on their laptop.
This is the code I'm using to add one of the command buttons on the spreadsheet (it is essentially the same for the other button, just different variables):
Dim i As Long, Hght As Long
Dim Name As String, NName As String
i = 0
Hght = 305.25
NName = "cmdAction" & i
For Each OLEObject In ActiveSheet.OLEObjects
If Left(OLEObject.Name, 9) = "cmdAction" Then
Name = Right(OLEObject.Name, Len(OLEObject.Name) - 9)
If Name >= i Then
i = Name + 1
End If
NName = "cmdAction" & i
Hght = Hght + 27
End If
Next
Dim UpdateEntry As OLEObject, N%
Set UpdateEntry = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", Link:=False _
, DisplayAsIcon:=False, Left:=Selection.Offset(0, 23).Left, Top:=Selection.Offset(0, 23).Top, Width:=72, Height _
:=24)
UpdateEntry.Name = NName
UpdateEntry.Object.Caption = "Edit Entry"
With ThisWorkbook.VBProject.VBComponents(ActiveSheet.CodeName).CodeModule
N = .CountOfLines
.InsertLines N + 1, "Private Sub " & NName & "_Click()"
.InsertLines N + 2, vbTab & "Code for button goes here"
.InsertLines N + 3, vbTab & "End Sub"
End With
I was wondering if it was possible to do the same thing, but that the buttons created are form control instead of ActiveX?
The error that is displayed is Run-time error 32809: Application-defined or object-defined error. After extensive research, I've found that it happens due to the sheet getting corrupted once a different version of Windows has altered it. The only way to fix it is to create a new sheet, copying all of the contents to the new sheet, deleting the corrupted sheet and renaming the new one to the name it had previously. This works, but it is not possible to copy the ActiveX Controls, because they will be renamed and the appropriate code will not be in them, however the Form Control on the spreadsheet used to open the UserForm will work just fine, which is why I think my only solution would be to change all ActiveX to Form Control.
Would appreciate some help.
Instead of using ActiveX buttons, use Shapes and set the Shape.OnAction property to call the macro that you would normally place behind the ActiveX button. In the macro you can use Application.Caller to get the name of the shape that was clicked, thus allowing you to know which button was clicked and to branch your code accordingly.
I have a macro that creates a command button however I am unable to assign any macro to the button in the VBA
have looked at this link but its for a userform (but I'm not good enough to be able to change it to suit what I need)
The code I am currently tring is below, I'm guessing I need to add something to the With Statement but I dont know what it would be
Dim MyR As Range, MyB As OLEObject
Dim MyR_T As Long, MyR_L As Long
Set MyR = Range("I3") 'just an example - you get that from your own script
MyR_T = MyR.Top 'capture positions
MyR_L = MyR.Left '...
'create button
Set MyB = ActiveSheet.OLEObjects.Add(ClassType:="Forms.CommandButton.1", _
Link:=False, DisplayAsIcon:=False)
'set main button properties
With MyB
.Name = "MyPrecodedButton" 'important - code must exist ... see below
.Object.Caption = "Load UseForm"
.Top = MyR_T
.Left = MyR_L
.Width = 130
.Height = 30
.Placement = xlMoveAndSize
.PrintObject = True 'or false as per your taste
End With
So from your own link you have posted, your code would look like this:
Set UF = ActiveWorkbook.VBProject.VBComponents("Name_of_the_userform")
With UF.CodeModule
.InsertLines 2, _
"Private Sub " & MyB.Name & "_Click()" & Chr(13) & _
"****HERE COMES YOUR FUNCTION CALL FOR THE BUTTON****" & Chr(13) & _
"End Sub"
End With
But this only works with activeX Buttons. What it does is quite a hack... so if you have a better solution i would not recommend this one. What it does is this: Every ActiveX Button has a onclick function with the following Syntax: "ButtonName_Click()" If you somewhere in your code put this line, it will be executed on click. now what the code does (as in the link which you have posted), is it writes These functions into the userform code.
Use .onAction method
Something like this
Sheets("someVeryFunnySheetName").buttons("someSeriousButtonName").onAction = "macroName"
Here is one example, if you wana to pass parameter to that macro (axleOutputSHeetCounter is some integer i think)
With chartSheet.Buttons("closeOutputSheet")
.OnAction = "'Module7_Axle.closeOutputSheet """ & axleOutputSheetCounter & """'"
.Characters.text = "Delete sheet"
.Characters.Font.Size = 16
End With
edit: for activeX buttons here you can find question with same issue and working solution
I have a macro in Powerpoint that gives me Information of a Shape. To bypass the error if no shape is selected I insert an errormask. However, this is very annoying.
Is it therefore possible to grey out the button if e.g. no Shape is selected. That way the user would npot even have a chance to click it.
Custom UI XML:
http://pastebin.com/T6NQ8WF8
Assuming you are using a 2007+ version of PowerPoint, the only way to manipulate the ribbon controls, buttons, etc., is through ribbon extensibility. It is possible to do this at run-time, with a vba hook, but it is much more difficult than in previous versions of PowerPoint where you could just use VBA to manipulate the controls' .Enabled or .Visible properties.
Here is an example of using ribbon extensibility to customize the ribbon at run-time. As you can see, it is not easy. I will show this in Option 2, below.
In this case, you have an error condition that you can easily identify using the .Type property of the Selection.ShapeRange. I think that attempting to conditionally disable this button at run-time (Option 2, below) is probably more trouble than it is worth.
Update
Is there a setting that greys your all buttons that don't have an effect.
No. The macros are the "effect", even if the result of the macro is that no action is performed. What you are asking is whether there is a setting which can compile and interpret your macros, determine whether that macro performs "an action" (e.g., manipulates a shape, changes a property assignment, etc.) and then disable buttons based on this determination. There is no such setting.
OPTION 1 -- Simply Do Not Display the MsgBox; Perform No Action if Invalid Selection
I will make some edits to clean up your code and use a better method of avoiding that error:
Sub Infos()
Dim n as String
Dim w as String
Dim h as String
Dim l as String
Dim T as String
With ActiveWindow.Selection.ShapeRange
Select Case .Type
Case 0
'MsgBox ("No shape selected.")
Exit Sub
Case Else
n = .Name
w = .Width
h = .Height
l = .Left
T = .Top
MsgBox "Name: " & n & Chr$(CharCode:=13) & "Länge: " & w & _
Chr$(CharCode:=13) & "Höhe: " & h & Chr$(CharCode:=13) & _
"Linkeposition: " & l & Chr$(CharCode:=13) & "Höhenposition: " & T
End Select
End Sub
OPTION 2 -- Use an Application Event Handler and Manipulate Ribbon at Run-Time
I mentioned that this is not easy. I uploaded an example file to Google Docs Presentation1.pptm. This should get you started. You can see now how much difficult this method is. If you are creating a PPAM/Add-In file, there are further considerations and complexities you may encounter. Good luck!
There are several errors in your code.
1. Your XML is not valid when I check in Custom UI Editor. I edited it here:
http://pastebin.com/SpG0Rtqq
2. Your Infos macro contains errors. You omit the End With statement, also, your n assignment will fail (and the rest of them will produce strange result) if the selection is multiple shapes. You can fix that by:
n = IIf(.ShapeRange.Count > 1, "Multiple shapes", .ShapeRange(1).Name)
w = IIf(.ShapeRange.Count > 1, "Multiple shapes", .ShapeRange(1).Width)
h = IIf(.ShapeRange.Count > 1, "Multiple shapes", .ShapeRange(1).Height)
l = IIf(.ShapeRange.Count > 1, "Multiple shapes", .ShapeRange(1).Left)
T = IIf(.ShapeRange.Count > 1, "Multiple shapes", .ShapeRange(1).Top)
Once you have fixed those components...
Add a module called mod_EventHandler, which includes this code. This will create an application event-handler class object, cEventClass:
Option Explicit
Public cPPTObject As New cEventClass
Public TrapFlag As Boolean
Sub TrapEvents()
'Creates an instance of the application event handler
If TrapFlag = True Then
MsgBox "Relax, my friend, the EventHandler is already active.", vbInformation + vbOKOnly, "PowerPoint Event Handler Example"
Exit Sub
End If
Set cPPTObject.PPTEvent = Application
TrapFlag = True
End Sub
Sub ReleaseTrap()
If TrapFlag = True Then
Set cPPTObject.PPTEvent = Nothing
Set cPPTObject = Nothing
TrapFlag = False
End If
End Sub
Since we need this class object, add a class module to your PowerPoint file, named cEventClass. In this module, put this code below. This code forces a refresh of the ribbon. This procedure implicitly calls the EnabledBtInfo subroutine, which then tests if the current selection is Shape(s).
Option Explicit
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
'Force refresh of the "btInfo" button:
RefreshRibbon "btInfo"
End Sub
And finally, another standard code module with this code to control the Button's visibility/enabled. Note that EnabledBtInfo is the VBA Hook for this button, and it tests whether Selection is shapes, before refreshing the ribbon:
Option Explicit
Public Rib As IRibbonUI
Public xmlID As String
'Callback for customUI.onLoad
Sub RibbonOnLoad(ribbon As IRibbonUI)
TrapEvents 'instantiate the event handler
Set Rib = ribbon
End Sub
Sub EnabledBtInfo(control As IRibbonControl, ByRef returnedVal)
'Check the ActiveWindow.Selection.ShapeRange
returnedVal = (ActiveWindow.Selection.Type = ppSelectionShapes)
Call RefreshRibbon(control.Id)
End Sub
Sub RefreshRibbon(Id As String)
xmlID = Id
If Rib Is Nothing Then
MsgBox "Error, Save/Restart your Presentation"
Else
Rib.Invalidate
End If
End Sub
When a shape(s) is selected, the magnifying glass icon is enabled:
When shape(s) is not selected, button is disabled:
And finally, when multiple shapes are selected:
In microsoft excel vba, I am attempting to assign hyperlinks and/or actions to shapes I have drawn. Here is roughly what I have tried (uncomment only one line at a time)
Basically, what I want to do is allow users to get more information by clicking on a shape object. Hyperlinks are fine, but some kind of event handler which accepts parameters would be ideal. I will be creating hundreds of these shapes, and they need to link to unique places in the document.
Dim destinationHyperlinkCell as Range
set destinationHyperlinkCell = Range("10:10")
' (do some stuff here)...
With Sheet1.Shapes.AddTextbox(msoTextOrientationHorizontal, _
600, _
600, _
300, _
16)
.TextFrame.Characters.Text = "Test this thing"
.Name = destinationHyperlinkCell.Address & " group of shapes"
'.Hyperlink.Address = destinationHyperlinkCell.Address
'.Hyperlink.Range = destinationHyperlinkCell.Address
'.OnAction = "'showDebugMsg """ & .Name & """'"
End With
use "Assign Macro ..." to define a macro to each shape which fires on "Click"
You can use the same macro for each shape and use the Application.Caller property to get the name of the shape which fired the macro. Then you have all the ingredients to write an intelligent handler - like a (hidden) Excel table that resolves shape name into an URL, text or whatever
Sub Shape_Click()
MsgBox "Co-Cooo! from" & Application.Caller
End Sub
Hope that helps
Good luck - MikeD