I'm developing a PowerPoint C# VSTO add-in. I want to be able to capture a text changed event whenever the Title text of a slide is changed.
How can I attach a custom event handler that will fire whenever the Title text is changed?
Two things: 1) this is in VBA, but should be easily portable to C# and VSTO, 2) The "text changed" thing is a bit tricky. I can get you as far as "are you in a Title box" - the rest is more trival. It has to do with finding original state versus any changes. Probably doable, I just haven't done it.
To hook a selection change in PPT VBA, you'll need one class and one module. In the class, put this:
Public WithEvents PPTEvent As Application
Private Sub PPTEvent_WindowSelectionChange(ByVal Sel As Selection)
With Sel
If .Type = ppSelectionText Then
Dim sh As Shape: Set sh = .ShapeRange(1)
If sh.Type = msoPlaceholder Then
originalText = sh.TextFrame.Text
Dim placeHolderType As Integer
placeHolderType = sh.PlaceholderFormat.Type
If placeHolderType = ppPlaceholderTitle Then
MsgBox "this is a title placeholder"
End If
End If
End If
End With
End Sub
Name the class "clsPPTEvents". Then in any module, put the following:
Public newPPTEvents As New clsPPTEvents
Sub StartEvents()
Set newPPTEvents.PPTEvent = Application
End Sub
Sub EndEvents()
Set newPPTEvents.PPTEvent = Nothing
Set newPPTEvents = Nothing
End Sub
Press F5 on the StartEvents and that will enable the hook. Press F5 on the EndEvents to disable it.
Related
I am writing an app that send reports to a word document, this is done by the usage of data that is displayed on a continuous form, one form has the data that display's the selected headers that will be printed onto the report, the user can then change the font style by the usage of the windows font window.
This all works fine, what I want to do now is then update the text box on the continuous form with the font styles that have been stored in the data table, so that the user can see the font and style they have selected.
I have tried various approaches to no success, the last method I have tried I will post below in code.
dim i as integer
Private Sub Form_Load()
i = 0
End Sub
Private Sub Form_Current()
i = i + 1
Me.txtchapterName.Tag = "ctrl" & i
End sub
Function SetFieldProperties()
Dim rst As Recordset
Dim ctrl As TextBox
Set rst = Me.Recordset
Set ctrl = Me.ActiveControl
If rst.RecordCount > 0 Then
If ctrl.Tag = Me.txtchapterName.Tag Then
ctrl.ForeColor = Nz(Me![TextFontColour], 0)
ctrl.FontName = Nz(Me![TextFontName], "Calibri")
ctrl.FontSize = Nz(Me![TextFontSize], 14)
ctrl.FontUnderline = Nz(Me![TextFontAlign], 0)
ctrl.FontBold = Nz(Me![TextFontBold], False)
End If
End If
End Function
Private Sub txtchapterName_AfterUpdate()
SetFieldProperties
End Sub
To some extent this works, but it will update all of the controls on the form with the font style.
For clarity my question is in the title of the post...
Thank you all in advance.
Mark.
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
Is there a way to runtime copy image from worksheet to userform image control?
I got a shape on a worksheet containing image. And when I select --> copy (ctrl + C) this shape, go to the UserForm1 design --> image1 properties I can do ctrl + v in the picture property of image1 and the image is pasted from clipboard to image1 control.
How can I achieve this using VBA in runtime?
I tried UserForm1.Image1.Picture = ActiveSheet.Shapes("Picture 1").Picture
And many similar bot none of them work
I usually get "Object doesn't support this property or method" or "Type mismatch"
Some time ago I was looking for a solution of the same problem. Did not find a solution, but I found a great workaround:
Make a separate form with plenty of pictures in it. Name it user_form_pics.
Then call the following on your form:
Me.Image1.Picture = user_form_pics.img_name11.Picture
This is how to use it in the constructor:
Private Sub UserForm_Initialize()
Me.Image1.Picture = user_form_pics.img_name11.Picture
End Sub
It works! Now your form has the picture of the user_form_pics.img_name11
Edit:
In case that you need to save Chart to picture, the procedure is the following:
Option Explicit
Public Sub TestMe()
Dim chtChart As Chart
Dim strPath As String
Set chtChart = ActiveSheet.ChartObjects(1).Chart
strPath = ThisWorkbook.Path & "\myChart.bmp"
chtChart.Export (strPath)
UserForm1.Show vbModeless
UserForm1.Image1.Picture = LoadPicture(strPath)
End Sub
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:
I have found many resources on the internet that do almost what i want to do, but not quite.I have a named range "daylist". For each day in the dayList, i want to create a button on a user form that will run the macro for that day. I am able to add the buttons dynamically but dont know how to pass the daycell.text from the named range, to the button, to the event handler, to the macro :S Heres the code i have to create the user form:
Sub addLabel()
ReadingsLauncher.Show vbModeless
Dim theLabel As Object
Dim labelCounter As Long
Dim daycell As Range
Dim btn As CommandButton
Dim btnCaption As String
For Each daycell In Range("daylist")
btnCaption = daycell.Text
Set theLabel = ReadingsLauncher.Controls.Add("Forms.Label.1", btnCaption, True)
With theLabel
.Caption = btnCaption
.Left = 10
.Width = 50
.Top = 20 * labelCounter
End With
Set btn = ReadingsLauncher.Controls.Add("Forms.CommandButton.1", "runButton", True)
With btn
.Caption = "Run Macro for " & btnCaption
.Left = 80
.Width = 80
.Top = 20 * labelCounter
' .OnAction = "btnPressed"
End With
labelCounter = labelCounter + 1
Next daycell
End Sub
To get around the above issue i currently prompt the user to type the day they want to run (e.g. Day1) and pass this to the macro and it works:
Sub B45runJoinTransactionAndFMMS()
loadDayNumber = InputBox("Please type the day you would like to load:", Title:="Enter Day", Default:="Day1")
Call JoinTransactionAndFMMS(loadDayNumber)
End Sub
Sub JoinTransactionAndFMMS(loadDayNumber As String)
xDayNumber = loadDayNumber
Sheets(xDayNumber).Activate
-Do stuff
End Sub
So for each of my runButtons, it needs to display daycell.text, and run a macro that uses that same text as a parameter to select the worksheet to do its stuff on.
Any help would be awesome. Ive seen responses that dynamically writes the vba code, to handle the macros, but i believe there must be someway it can be done a little more elegantly through passing parameters, just not sure how. Many thanks in advance!
I know you have accepted a solution now that will work for you and is much simpler than the below, but if you're interested, this would be the more direct answer to your question.
You need to create a class to handle the button clicks, so every time the button is clicked it uses the event in the class, you only need to do this once then create a new instance of it for every button. To stop these classes going out of scope and being lost, they need storing in a class level declaration. In the below I've moved your code around a little.
In the class module (I've called it cButtonHandler)
Public WithEvents btn As MSForms.CommandButton
Private Sub btn_Click()
MsgBox btn.Caption
End Sub
With events is used as it allows you to use most of the events for the control. I've moved the button generation code into the userform as below:
Dim collBtns As Collection
Private Sub UserForm_Initialize()
Dim theLabel As Object
Dim labelCounter As Long
Dim daycell As Range
Dim btn As CommandButton
Dim btnCaption As String
'Create a variable of our events class
Dim btnH As cButtonHandler
'Create a new collection to hold the classes
Set collBtns = New Collection
For Each daycell In Range("daylist")
btnCaption = daycell.Text
Set theLabel = ReadingsLauncher.Controls.Add("Forms.Label.1", btnCaption, True)
With theLabel
.Caption = btnCaption
.Left = 10
.Width = 50
.Top = 20 * labelCounter
End With
Set btn = ReadingsLauncher.Controls.Add("Forms.CommandButton.1", "runButton", True)
With btn
.Caption = "Run Macro for " & btnCaption
.Left = 80
.Width = 80
.Top = 20 * labelCounter
'Create a new instance of our events class
Set btnH = New cButtonHandler
'Set the button we have created as the button in the class
Set btnH.btn = btn
'Add the class to the collection so it is not lost
'when this procedure finishes
collBtns.Add btnH
End With
labelCounter = labelCounter + 1
Next daycell
End Sub
Then we can call the useform from a separate routine:
Sub addLabel()
ReadingsLauncher.Show vbModeless
End Sub
Classes in VBA aren't particularly well covered in many VBA books (generally you need to read VB6 books to get an understanding), however once you understand them and how they work, they become incredibly useful :)
Hope this helps
EDIT - to address additional queries
To refer to objects in a collection, this is either done through the key or the index. To use the key, you need to add it as you add the item to the collection, so:
collBtns.Add btnH
Would become
collBtns.Add btnH, btnCaption
For this reason, keys must be unique. You can then refer as follows:
'We refer to objects in a collection via the collection's key
'Or by it's place in the collection
'So either:
MsgBox collBtns("Monday").btn.Caption
'or:
MsgBox collBtns(1).btn.Caption
'We can then access it's properties and methods
'N.B you won't get any intellisense
collBtns("Monday").btn.Enabled = False
You can also add additional properties/method to your class if required, so for example:
Public WithEvents btn As MSForms.CommandButton
Private Sub btn_Click()
MsgBox btn.Caption
End Sub
Public Property Let Enabled(value As Boolean)
btn.Enabled = value
End Property
Would then be accessed:
collBtns("Monday").Enabled = False
Does this help? For further reading I would point you towards Chip Pearson's site, he has great stuff on most topics http://www.cpearson.com/excel/Events.aspx
Just remember that VBA is based on VB6 so is not a fully fledged OO language, for example, it does not support inheritance in the normal sense, only interface inheritance
Hope this helps :)
Example of catching click on worksheet. Put this in the worksheet module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
' e.g., range(A1:E1) is clicked
If Not Application.Intersect(Target, Range("A1:E1")) Is Nothing Then
MsgBox "You clicked " & Target.Address
End If
End Sub