I have added a rectangle shape to a spreadsheet. I now wish to use a macro on event RectangleA_Click(). I know the shape's name is RectangleA as I have the below sub:
Sub f()
Dim Shape As Shape
For Each Shape In ActiveSheet.Shapes
Debug.Print Shape.Name
Next
End Sub
I have written the code:
Private Sub RectangleA_Click()
MsgBox "hello"
End Sub
In the relevant sheet object space in the editor. On clicking the shape the subroutine is not called.
I am aware that I can assign this using right click> assign macro, but would prefer to avoid this as it seems like an unnecessary step. I'm also aware that there are Active X controls which automatically assign the macro, again I would prefer to avoid this if possible.
Something like this may work:
Sub AssignMacroToShape()
Set shpTemp = ActiveSheet.Shapes.AddShape(msoShapeRectangle, 1680#, 594#, 120#, 74.25)
shpTemp.OnAction = ActiveWorkbook.Name & "!Macro Name"
End Sub
But it will be much easier just to right click > Assign Macro.
This above code is useful if you need to create the shape then assign a macro to it after creation.
You can look into the OnAction event to get the answer to specifics if this doesn't help.
Related
I would like to make a macro in Powerpoint that enables me to create shapes in a similar fashion as when you select the autoshapes in the autoshape overview (i.e. once you call the macro you have a possibility to click to set the coordinates and subsequently you drag and click to set the width&height). Also, I would like to give it pre-set cosmetic characteristics (e.g. certain inner margins, fill color, border style and transparancy), which will be defined in the vba code.
I am aware of .addshapes(), however, this requires coordinates and height/width as input. Moreover, I have not find any posts / documents on vba to create shapes without defined coordinates and height/width.
Anyone some ideas on how to tackle this challenge?
Many thanks in advance!
Sofar
Building on what John Korchok suggested, here's code that retrieves the just-drawn shape so that your code can resume and manipulate it...
Sub testAppComBars()
Dim SHP As Shape
Application.CommandBars.ExecuteMso ("ShapeFreeform")
Stop
Set SHP = Selection.ShapeRange(1)
With SHP.Fill
.ForeColor.RGB = RGB(192, 0, 0)
.Transparency = 0.75
End With
End Sub
I would hope there's a more elegant solution than using Stop to pause code execution while the user picks the shape's location (or in this case, draws a freeform polyline/polygon), but that's all I could come up with off the top of my head.
I was fascinated by this problem and think this might help you.
Consider that when you draw a new autoshape, you have changed the window selection, and created a new selection ShapeRange with exactly 1 item (the new shape).
So by setting a WindowSelectionChange event, you're able to apply any formatting you wish at the time of creation.
First create a class module called cPptEvents with the following:
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal sel As Selection)
On Error GoTo Errhandler
Debug.Print "IN_PPTEvent_WindowSelectionChange"
Dim oShp As Shape
If (ActiveWindow.ViewType = ppViewNormal) Then
With sel
If .Type = ppSelectionShapes Then
If .ShapeRange.Count = 1 Then
Set oShp = .ShapeRange(1)
If oShp.Type = msoAutoShape Then
If oShp.AutoShapeType = msoShapeOval Then
If oShp.Tags("new_oval") = "" Then
oShp.Fill.ForeColor.RGB = RGB(255, 0, 0)
oShp.Tags.Add "new_oval", "true"
End If
End If
End If
End If
End If
End With
End If
Exit Sub
Errhandler:
Debug.Print "Error: " & Err.Description
End Sub
This checks the selection every time it changes. If there's an oval selected, it looks for the "new_oval" tag, which will not exist for a newly created shape. In that case, it applies a red fill, although of course once you get to this point you can call an entirely different sub, pass along the shape, and do whatever you want formatting-wise to it.
By adding that "new_oval" tag, you ensure that the formatting will not be applied to an oval that hasn't been newly created. This allows the user to make manual changes to the formatting as needed -- otherwise you're just resetting the formatting every time the user selects an oval.
Note that for the _WindowSelectionChange event to be running in the background, you have to call this at some point:
Public MyEventClassModule As New cPptEvents
'
Public Sub StartMeUp()
Set MyEventClassModule.PPTEvent = Application
End Sub
You can include that one line from StartMeUp above in whatever Ribbon_Onload sub is triggered by your addin, if you're making a new addin ribbon.
With this solution, you don't even have to give the end user a special button or set of tools to create the shapes that are being formatted. It happens invisibly whenever the user draws a new shape from the native PPT tools.
This will put your cursor in drawing mode to draw an oval. After running, you may have to click on the slide once, then the cursor will change shape and you can draw an oval:
Sub DrawOval()
Application.CommandBars.ExecuteMso ("ShapeOval")
End Sub
Other commands to substitute for ShapeOval:
ShapeRectangle
ShapeElbowConnectorArrow
ShapeStraightConnectorArrow
Get the full list in Excel spreadsheets from Microsoft Office 2016 Help Files: Office Fluent User Interface Control Identifiers
Look for the powerpointcontrols.xlsx file and search the first column with "shape"
There are 173 shapes in the menu, so you have a lot of macros to write.
I have the following code in VBA (MS Word), that is meant to run after I click in a button, named cmdFormPreencher inserted in my Document:
Private Sub cmdFormPreencher_Click()
'
If ActiveDocument.FormsDesign = False Then
ActiveDocument.ToggleFormsDesign
End If
'
ThisDocument.cmdFormPreencher.Select
ThisDocument.cmdFormPreencher.Delete
ActiveDocument.ToggleFormsDesign
'
UserForm2.Show
End Sub
The purpose of the code above is to delete that button inserted in my document.
But when I run the code only the button is selected. When I tried to figure out what is happening by debugging, it showed me the code runs until ActiveDocument.ToggleFormsDesign and not running the code remaining
Is this a bug of VBA, or am I doing something wrong? If so, how can I get around this problem?
Thanks!
Note: The ActiveX button is not in Header and Footer. The Text Wrap is set to In Front of Text
Edit:
When I try to run a macro, activating FormDesign, Selecting the ActiveX button and then deleting, I get this code:
Sub Macro1()
'
' Macro1 Macro
'
'
ActiveDocument.ToggleFormsDesign
ActiveDocument.Shapes("Control 52").Select
Selection.ShapeRange.Delete
ActiveDocument.ToggleFormsDesign
End Sub
But when I run this code nothing happens...
This is by design. When an Office application is in Design Mode code should not run on an ActiveX object that's part of the document.
I take it this is an ActiveX button and in that case, it's a member of the InlineShapes or Shapes collection - Word handles it like a graphic object. It should be enough to delete the graphical representation, which you can do by changing it to display as an icon instead of a button.
For example, for an InlineShape:
Sub DeleteActiveX()
Dim ils As word.InlineShape
Set ils = ActiveDocument.InlineShapes(1)
ils.OLEFormat.DisplayAsIcon = True
ils.Delete
End Sub
You just have to figure out how to identify the InlineShape or Shape. You could bookmark an InlineShape; a Shape has a Name property.
EDIT: Since according to subsequent information provided in Comments you have a Shape object, rather than an InlineShape, the following approach should work:
Dim shp As word.Shape
Set shp = ActiveDocument.Shapes("Shape Name") 'Index value can also be used
shp.Delete
Note that Word will automatically assign something to the Shape.Name property, but in the case of ActiveX controls these names can change for apparently no reason. So if you identify a control using its name instead of the index value it's much better to assign a name yourself, which Word will not change "on a whim".
Activate Design Mode.
Click on the control to select it
Go to the VB Editor window
Ctrl+G to put the focus in the "Immediate Window"
Type the following (substituting the name you want), then press Enter to execute:
Selection.ShapeRange(1).Name = "Name to assign"
Use this Name in the code above
I'm trying to write an Excel 2007 macro for a coworker, but my VBA skills are pretty basic (pardon the pun). Essentially, what needs to happen is, when a checkbox is clicked, the neighboring cell to the right is filled with the username of the person logged in.
So far, here's the code I've come up with that allows me to do that:
Sub CheckBox1_Click()
Range("J4").Activate
If ActiveCell.Offset(0, 18).Value = True Then
ActiveCell.Offset(0, 1).Value = Environ("UserName")
Else
ActiveCell.Offset(0, 1).Clear
End If
End Sub
Just for the sake of reference, that "ActiveCell.Offset(0,18)" refers to a cell that is linked to the checkbox in question and contains its true/false value.
(EDIT: Also, the reason cell J4 is activated is because in this case, it's the cell containing the ActiveX checkbox)
That works perfectly, but that's not my problem. My problem is this: there are 49 more checkboxes in that row, and three more rows on this sheet, and 45 more sheets in this book. I do NOT want to have to copy paste the same code into a unique macro just to change the active cell. More importantly, as a good programmer, I shouldn't be repeating code like that. How should I write this so that I don't have to refer to a distinct cell every time?
EDIT 2: Holy smokes, Lance just helped me realize I was mistaken. The sheet uses form controls, not ActiveX controls. Greatly sorry, everyone.
While this is easy to do with a Sheet object, it's pretty hard to do with an ActiveX Control object. You can't self-reference the name of an ActiveX Control in its event, unless it's passed to it, and you also can't reference the name of the event subroutine to extract the name, and you can't reference the name of the routine that called a routine.
I also attempted to trigger off of the Worksheet Change and SelectionChange events, but those don't trigger off of a checkbox change, even if it has a LinkedCell that changes
What I finally came up with was the somewhat generic wrapper for the click event, that you'll have to modify the string to match the Checkbox name:
Private Sub CheckBox1_Click()
NameCopy Me, "CheckBox1"
End Sub
and then a Namecopy function that sets the cell -7 to the left of the LinkedCell to the name value.
Public Sub NameCopy(wsheet As Worksheet, cname As String)
If wsheet.OLEObjects(cname).Object.Value = True Then
Range(wsheet.OLEObjects(cname).LinkedCell).Offset(0, -7).Value = Environ("UserName")
End If
End Sub
It's easier with a Forms checkbox, you can use this Macro for all your checkboxes. Just remember to set the Macro to this:
Public Sub NameCopy()
Dim shp As Shape
Set shp = ActiveSheet.Shapes(Application.Caller)
If shp.ControlFormat.Value = xlOn Then
ActiveSheet.Range(shp.ControlFormat.LinkedCell).Offset(0, -7).Value = Environ("UserName")
End If
End Sub
Since you are using form controls, this is really easy. You can use Application.Caller to have the code access the clicked checkbox, and then use it's TopLeftCell property to get where the checkbox is located, and then you can perform whatever operation you want. In your case, something like this I'm guessing:
Sub Checkbox_Click()
With ActiveSheet.CheckBoxes(Application.Caller)
If .Value = 1 Then 'Checkbox is checked
.TopLeftCell.Offset(, 1).Value = Environ("UserName")
Else
.TopLeftCell.Offset(, 1).ClearContents
End If
End With
End Sub
I have a VBA code in Visio that will change the color of the shape if said shape is hyperlinked. Right now, I run it by using a simple command button. I want the macro to run when a change occurs in the worksheet. I know in excel if I wanted to do that I would simply place my code in the Workbook_Change sub, but in Visio I am lost.
Here is my current code:
Private Sub CommandButton1_Click()
Dim Sh As Visio.shape
Dim Link As Hyperlink
For Each Sh In Visio.ActivePage.Shapes '<~ loop through the shapes collection
For Each Link In Sh.Hyperlinks '<~ loop through the links collection
If Not Link.Address = "" Then '<~ check for a blank address
Sh.Cells("Fillbkgnd").Formula = "RGB(255,102,0)"
Sh.Cells("Fillforegnd").Formula = "RGB(255, 102, 0)" '<~ apply a color to the shape
End If
Next Link
Next Sh
End Sub
Any ideas?
#JonFournier I have revisted this and here is my code that lives in ThisDocument:
Public WithEvents Pg As Visio.Page
Private Sub Pg_CellChanged(ByVal Cell As IVCell)
Set Pg = Pages("Page-1")
If Cell.Section = visSectionHyperlink Then
Dim Sh As Visio.shape
Dim Link As Hyperlink
For Each Sh In Visio.ActivePage.Shapes '<~ loop through the shapes collection
For Each Link In Sh.Hyperlinks '<~ loop through the links collection
If Not Link.Address = "" Then '<~ check for a blank address
Sh.Cells("Fillbkgnd").Formula = "RGB(255,102,0)"
Sh.Cells("Fillforegnd").Formula = "RGB(255, 102, 0)" '<~ apply a color to the shape
End If
Next Link
Next Sh
Else
End If
End Sub
The code that I put inside works perfectly fine when paired with a command button, but I would like it to work when the shape is changed. What else should I add to the code to "instantiate the object" or to get it to run the way I need it to. I can't seem to get anything to work. Appreciate the help.
Again, I am sorry this is appearing as an answer, my work firewalls will not allow me to comment for some reason.
You can catch the CellChanged event on the Page object, and check if the changed cell is in the hyperlink shapesheet section.
In a class module:
Public Withevents Pg as Visio.Page
Private Sub Pg_CellChanged(ByVal Cell as IVCell)
If Cell.Section = visSectionHyperlink Then
' call your code here
End If
End Sub
You would need to instantiate the object and keep it alive to monitor your active page, but this is the general gist of something that would work for you, I think.
This would also live happily in ThisDocument, if you'd prefer that.
I have created different shapes in excel and have assigned a macro to it which functions as activating another sheet. I want to put all these under one macro and then assign it to different shapes with different linking property. But this code doesn't work because obviously I am doing something stupid. Can someone please help?
Dim shp As ShapeRange, ws As Sheets, i As Integer
Set ws = ActiveWorkbook.Sheets(Array("Introduction", "S1 Fuel Consumption", "S1 Fugitive", "S2 Electricity Consumption"))
Set shp = ws(2).Shapes.Range(Array("Chevron1", "Chevron2"))
Select Case shp(i)
Case shp(1)
ws(1).Activate
Case shp(2)
ws(3).Activate
End Select
End Sub
There is a much easier way to do "buttons" in VBA (I assume this is what your trying to achieve)
First off, in a module, create the "Open Worksheet" code:
Sub Open_Sheet2
Sheets("Sheet2").visible = True
Sheets("Sheet2").Activate
End Sub
Then right click your shape, choose Assign Macro and assign Open_Sheet2 to that shape. Now when it is clicked, it will open Sheet2