Combo box to list Macros - vba

I want when you hit 'send' you are presented with a form. This I am developing in Outlook 2010.
Is there a way to populate a combo-box with a list of Macros?
Public Sub Confidential()
Application.ActiveInspector.CurrentItem.Sensitivity = olConfidential
Application.ActiveInspector.CurrentItem.Save
Set MsgSub = Outlook.Application.ActiveInspector.CurrentItem
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
Subject = MsgSub.Subject
MsgSub.Subject = Subject + " - [CONFIDENTIAL]"
Email = objMail.HTMLBody
info = " <html> <body> <FONT color=#666666> <font-size: 11px> <p></p> AUTO TEXT: This message has been marked as 'CONFIDENTIAL' please treat it as such </body> </font> </html>"
objMail.HTMLBody = Email + info
End Sub
Private Sub Sens_DropButtonClick()
Sens.AddItem "Confidential()"
Sens.AddItem "Normal()"
End Sub
Public Sub Send_Click()
Set objMail = Outlook.Application.ActiveInspector.CurrentItem
objMail.Send
End Sub
Would I be right in thinking that this is a public sub?
My goal is when you hit the 'send' button a form will appear with a dropdown box, this has 4 options which are the sensitivity options you can use with the emails, except I have created them as macros and added code on them (to add to subject and footer of message) but I wont it so a user is forced to make a selection, hence why I am creating this form instead of having the 4 buttons.

My goal is when you hit the 'send' button a form will appear with a dropdown box, this has 4 options which are the sensitivity options you can use with the emails, except I have created them as macros and added code on them (to add to subject and footer of message) but I wont it so a user is forced to make a selection, hence why I am creating this form instead of having the 4 buttons. – Rsmithy 36 mins ago
If I understand you correctly, Yes it is possible to do what you want. See this Example
Let's say you have a userform with 4 options A,B,C and D and the userform code is
Private Sub UserForm_Initialize()
ComboBox1.AddItem "A"
ComboBox1.AddItem "B"
ComboBox1.AddItem "C"
ComboBox1.AddItem "D"
End Sub
Private Sub CommandButton1_Click()
lstNo = ComboBox1.ListIndex
Unload Me
End Sub
Next Paste this in a module
Public lstNo As Long
and this in the ThisOutlookSession
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
UserForm1.Show
MsgBox "user chose " & lstNo & "from combo"
Select Case lstNo
Case -1
'User didn't select anything in the combo
Case 0
'User selected option 1 in the combo
Case 1
'User selected option 2 in the combo
Case 2
'User selected option 3 in the combo
Case 3
'User selected option 4 in the combo
End Select
End Sub
Replace the above comments in the Select Statement` with the Macro Names that you want executed depending on the user choice.
SNAPSHOTS IN ACTION
And this is what you get when you select the Option D (ListIndex 3)
FOLLOWUP
Dim email As String, info As String
Private Sub Application_ItemSend(ByVal Item As Object, Cancel As Boolean)
UserForm1.Show
Select Case lstNo
Case -1
'User didn't select anything, default will be used
Case 0
With Item
.Sensitivity = olNormal
.Save
End With
Case 1
With Item
.Sensitivity = olPersonal
.Save
End With
Case 2
With Item
.Sensitivity = olPrivate
.Save
End With
Case 3
With Item
.Sensitivity = olConfidential
.Subject = .Subject & " - [CONFIDENTIAL]"
Email = .HTMLBody
info = " <html> <body> <FONT color=#666666> <font-size: 11px> <p></p> AUTO TEXT: " & _
"This message has been marked as 'CONFIDENTIAL' please treat it as such </body> </font> </html>"
.HTMLBody = Email & info
.Save
End With
End Select
End Sub

Is there a way to populate a combo-box with a list of Macros?
Not in Outlook, I'm afraid. Programmatic access to the VBA IDE isn't supported in Outlook due to the possibility of spreading viruses or conducting malicious activity via email.
See VBA Extensibility in Outlook for reference.
The closest you can come is by programmatically displaying the "Run Macro" dialog, like this:
ActiveExplorer.CommandBars.FindControl(,186).Execute
However I'm not sure if this is available in Outlook 2010.
But showing a dialog box can't possibly be your goal. Maybe if you explain what your goal is, someone can suggest a better way of reaching it that doesn't require populating a combo box with a list of macro names.

Related

Form closes but the written conditions therein not implemented

I have the following two codes on a button: The (first code) aims to submit value of option button into worksheet cell:
For Each FormControl In Me.Controls
'Check only OptionButtons
If TypeName(FormControl) = "OptionButton" Then
'Check the status of the OptionButton
If FormControl.Value = True Then
'Set a variable equal to the Caption of the selected OptionButton
OptionButtonValue = FormControl.Caption
'We found the selected OptionButton so exit the loop.
Exit For
End If
End If
Next
'Store input in the worksheet
Sheets("Answer Sheet").Range("E80").Value = OptionButtonValue
To ensure an option button is selected before proceeding to next form, i have
the 'following code (second code):
Dim cnt As Integer
For Each ctl In Me.Controls
If TypeName(ctl) = "OptionButton" Then
If ctl.Value = True Then cnt = cnt + 1
End If
Next ctl
If cnt = 0 Then MsgBox "Hello " & CStr(ThisWorkbook.Sheets("AccessReg").Range("D630").Value) & ", you
have not selected an answer! Please select an answer to proceed to next question. Thank you.",
vbInformation, "Please select an answer!" Else ScoreBoards.Show
Unload Me
MY CHALLENGES
Both codes above exists in my forms i.e. questions 1, 2, 3,...respectively, but can't seem to get the second code (that, which ensures an option button is selected before next form can be opened) to work by adding 'unload me' to the end of it, yet i want the form closed before proceeding to next. Adding 'unload me', pop-up the msgbox (which tells me to select an answer) but when i clicked okay on the msgbox, it closes the form (Question1) instead of returning me to same form to ensure an answer is clicked, then proceed to next form (Question2). However, when i remove the 'unload me', things work fine i.e. the msgbox popup when selection not made, returns to same form when okay on msgbox is clicked, and opens next form when selection made.
What i really want is: i want the second code above (which ensures an option button is selected before next form can be opened) to work as programmed and each form closed before proceeding to the next form.
Thank you in advance
PS:
The concept summary is:
On a userform (Question1), select an option button and submit the value to worksheet
Ensure an option button is selected:
if selected and button clicked, the next form(being Question2) should open
if not selected and button clicked, the msgbox (which tells me to select an answer), should popup
clicking okay on the msgbox, should return me to same form (Question1) so that i can select an option and proceed.
Try adapting your second code in the next way, please:
If cnt = 0 Then MsgBox "Hello " & _
CStr(ThisWorkbook.Sheets("AccessReg").Range("D630").Value) & ", you have not selected an answer! Please select an answer to proceed to next question. Thank you.", vbInformation, "Please select an answer!"
Exit For
Else
ScoreBoards.Show
Unload Me
End if

Cannot validate activex textboxes in form (not a userform) just a form in the Word document itself

I've looked all over for the solution to this, finally figured I would just ask.
I have a form I've created in Word. It is not a formal "userform1" type form as in a VB project. It is written all in the Word document itself.
I am going to have a lead person email my this report every evening. I have been able to successfully have the user click the submit button and email the form (MS Word (NighlyReport.DOCM)).
In the final stages now, I am "trying with no success" to validate all of my textboxes with no luck.
I want to make each textbox required and if the user does not enter a value, I would like the "setFocus" to return the user back to the textbox. Since I am not using an official "userform" I do not seem to have this method available to me - to return the user back to the form. I have tried
_Change
_GotFocus
_LostFocus
_KeyPress
_MouseDown
All of these work fine as long as I am inside the textbox. None of them sends the user back to it.
Does anybody know a way to do this. I wanted a straightforward nice looking form to fill out and attach to outlook (which I've done). Just need to validate the textboxes. I would be willing to validate all of them with a commandbutton as well, but still cannot get the focus back to the textbox that was not filled out by the user.
For the sake of simplicity, I am posting just two textboxes here and my basic validation that is not working. To be clear, I am not using the userform grid, maybe that makes all of this impossible to do.
Thanks ahead:
Private Sub txt1_Change()
If txt1.Value = "" Then
MsgBox "need your input"
Else
Exit Sub
End If
End Sub
Private Sub txt2_Change()
If txt2.Value = "" Then
MsgBox "need your input"
Else
Exit Sub
End If
End Sub
Try something along the lines of:
Dim iShp As InlineShape, StrOut As String
For Each iShp In ActiveDocument.InlineShapes
With iShp
If .Type = wdInlineShapeOLEControlObject Then
If .OLEFormat.ClassType Like "Forms.TextBox.*" Then
If Trim(.OLEFormat.Object) = "" Then StrOut = StrOut & vbCr & .OLEFormat.Object.Name
End If
End If
End With
Next
If StrOut <> "" Then
MsgBox "The following controls have not been completed: " & StrOut
Exit Sub
End If

How to add a macro to mutiple excel files using VBA

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

Select combobox if wrong item selected

I have an MS-Word 2013 document with several (legacy) formfields; some text boxes, some comboboxes. The first list item on all of the comboboxes is "(select one)" to let the end user know they need to make a selection (I did not draft or design this document, I've just been asked to write the VBA code for it). So I coded each to give a simple VBA message box, ran on exit, if that first selection was not changed, for example:
Public factor1 As Integer
Sub MyFormFieldFactor1()
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
Exit Sub
End If
If ActiveDocument.FormFields("cbofactor1").Result = "Yes" Then
factor1 = 1
Else
factor1 = 0
End If
End Sub
The word document automatically goes to the next formfield when you click ok on the message box. Through VBA, I want it to stay on the current formfield when "(select one)" is chosen. Bonus points if it stays on the current field and pulls up the list selection automatically.
Will this work:
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
ActiveDocument.FormFields("cbofactor1").SetFocus()
Exit Sub
End If
You can auto drop the list with something like:
SendKeys "%{down}", True
DoEvents
Full code:
If ActiveDocument.FormFields("cbofactor1").Result = "(select one)" Then
MsgBox "You must select either Yes or No."
ActiveDocument.FormFields("cbofactor1").SetFocus()
SendKeys "%{down}", True
DoEvents
Exit Sub
End If

Powerpoint VBA/Macro: Deactivate (Grey out) Button on Ribbon, if no shape is selected

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: