Referencing the object a macro is assigned to - excel

As the title states: in Excel 2010 how can I reference the object that a macro has been assigned to? I've created a spreadsheet with a form checkbox and assigned this macro to it:
Sub Toggle()
If ActiveSheet.Shapes("Checkbox1").OLEFormat.Object.Value = 1 Then
ActiveSheet.Shapes("Picture1").Visible = True
Else
ActiveSheet.Shapes("Picture1").Visible = False
End If
End Sub
The checkbox toggles whether or not a picture is visible and that's working fine but I'd like to reuse the script for multiple checkboxes.
The above code is specifically targeting Checkbox1 but I'd like it to target "this", the object I've assigned the macro to.
I feel like this should be really easy but I spent all evening on MSDN, excelforums.com and just googling around.
Thanks for your help!

Application.Caller is what you want
Sub Toggle()
Dim cb As String, shps As Shapes
cb = Application.Caller
Set shps = ActiveSheet.Shapes
shps("Picture1").Visible = (shps(cb).OLEFormat.Object.Value = 1)
End Sub

As far as I know that is not possible using VBA. Sure you could put the toggle code into a separate sub and re-use it. That might help a bit but you still need to specify the name of the checkbox.
Private Sub CheckBox1_Click()
Call Toggle("Checkbox1", "Picture1")
End Sub
Sub Toggle(ByVal Nm As String, ByVal pic As String)
If ActiveSheet.Shapes(Nm).OLEFormat.Object.Value = 1 Then
ActiveSheet.Shapes(pic).Visible = True
Else
ActiveSheet.Shapes(pic).Visible = False
End If
End Sub
You need to put the toggle sub in the same sheet as the checkbox code or else put the toggle sub in a module.

Related

Issue with adding hyperlinks to images from function

I'm trying to make a VB function that's going to add an image from the file path and add a hyperlink to it.
It needs to be called from a function, it can't be a Sub.
Here's the code I have so far:
Function AddHyperlinkedImage()
InsertPictureHyperlink
End Function
Sub InsertPictureHyperlink()
Dim pct As Picture, iLeft#, iTop#
Dim sFile As String
sFile = "C:\somepath\picture.jpg"
If Dir(sFile) = "" Then
Exit Sub
End If
With Range("A1")
.Select
iLeft = .Left: iTop = .Top
End With
Set pct = ActiveSheet.Pictures.Insert(sFile)
pct.Left = iLeft
pct.Top = iTop
With Worksheets("Sheet1")
.Hyperlinks.Add Anchor:=.Shapes(pct.Name), Address:="somexcel.xlsx"
End With
End Sub
It adds the picture, but it won't add the hyperlink. When I run the sub by itself, it adds the picture and hyperlinks it.
But I need it to be in the form of a function. It can't be a button or anything like that. I have to be able to call it with =SomeFunction()
For the life of me I can't figure out why it works when I just call it, but it doesn't work when I call the sub from inside a function.
Is there a way to do this?
So instead of a UDF you can try to utilize a Worksheet_Change event that will call your InsertPictureHyperlink() macro. To ensure the macro does not fire anytime you change a cell, add a condition to only fire the macro when a certain keyword is entered. Here the keyword will be AddHyperlinkedImage
Private Sub Worksheet_Change(ByVal Target As Range)
If Target = "AddHyperlinkedImage" Then
Application.EnableEvents = False
InsertPictureHyperlink
Application.EnableEvents = True
End If
End Sub
Sub InsertPictureHyperlink()
MsgBox "Macro enabled - add your code in this sub"
End Sub

VBA Excel Userforms, Show, Hide

I have a question regarding instances of userforms.
When a userform is constructed via an object in a module (e.g. set frm = new Userform2) can I hide it and restore it by the show method even when the sub is run until the end?
Let's say:
userform creation by sub1
entering values to the userform
hiding the userform with sub2
restore userform with all values by sub3 with the show method
I got really strange behavior when testing code with show and hide methods on module level or Userform Code but what I got finally to work is that using a global variable and the following code in a standard module:
Global frm As UserForm2
Option Explicit
Sub sub1()
Set frm = New UserForm2
With frm
.Show vbModeless
End With
End Sub
Sub sub2()
With frm
.Hide
End With
End Sub
Sub sub3()
With frm
.Show vbModeless
End With
End Sub
It's often said that global variables should be avoided. Is it even possible here? Do I miss something?
What I really want is to hide the userform but keep the instance with all values set before. Here is my original code and I now realized that I mixed things up and made and error. I had an "end" in a condition and this forces the UF not to show resp. killing all instances.
#Chronocidal:
In fact I hide within code within the UserForm. This is part of a button which transfers set data from UF to sheet. But I think that is not important where to hide or?
Now it is working as I expected. Thanks to all of you
Global myfrm As FormFillInformation
Option Explicit
Sub InitUserFormGeneralInformation()
Dim chkfrm As Boolean
chkfrm = CheckFrmIsHidden
If chkfrm = True Then
myfrm.Show vbModeless
End '<<<<<========== completely wrong but overseen
Else
Set myfrm = New FormFillInformation
myfrm.Show vbModeless
End If
End Sub
Function CheckFrmIsHidden() As Boolean
Dim frm As Object
CheckFrmIsHidden = False
For Each frm In VBA.UserForms
If frm.Name = "FormFillInformation" Then
CheckFrmIsHidden = True
End If
Next
End Function

Limit to only 1 selected checkbox

I have imported a table with check-boxes from Access to Excel. Is it possible to set the check-boxes where only one check-box can be selected from that imported table when using Excel?
In the comments Jeeped made an excellent point that radio buttons already have the functionality that you are looking for. On the other hand -- if you prefer the aesthetics of checkboxes then you can certainly use them. I created a userform with two checkboxes in a frame (and no other controls in the frame) and also included a label for displaying the chosen option. The following code deselects all other checkboxes in the frame when one is selected. I used a non-local Boolean variable to circumvent the other checkbox's event handlers while they were being changed to avoid a sort of echo effect I ran into where the events were firing when I didn't want them to (perhaps there is a less kludgy way to do that). The code easily extends to any number of checkboxes in a grouping frame.
Dim selecting As Boolean 'module level variable
Private Sub SelectOne(i As Long)
Dim c As Control
selecting = True
For Each c In Frame1.Controls
If c.Name <> "CheckBox" & i Then c.Value = False
Next c
DoEvents
Label1.Caption = i & " selected"
selecting = False
End Sub
Private Sub CheckBox1_Click()
If Not selecting Then SelectOne 1
End Sub
Private Sub CheckBox2_Click()
If Not selecting Then SelectOne 2
End Sub
I think this works best and its much easier - at least for a few boxes - for more you could write some formulas in excel and drag down then copy as values and copy paste text from excel into vba. Anyway, here it's how I did it:
I went and created code under each button - quite basic
Private Sub DateCheckBox1_Click()
If DateCheckBox1.Value = True Then
DateCheckBox2.Value = False
DateCheckBox3.Value = False
End If
End Sub
Private Sub DateCheckBox2_Click()
If DateCheckBox2.Value = True Then
DateCheckBox3.Value = False
DateCheckBox1.Value = False
End If
End Sub
Private Sub DateCheckBox3_Click()
If DateCheckBox3.Value = True Then
DateCheckBox2.Value = False
DateCheckBox1.Value = False
End If
End Sub

Assigning Excel VBA ActiveX ListBox .Selection to a TextBox

I'm trying to click a selection on an ActiveX ListBox and have value assigned to a TextBox then clear the ListBox. It seems straightforward but I'm
getting 'Object doesn't support this property or method' on the first line
This is what I'm using:
Private Sub ListBox1_Click()
ActiveSheet.OLEObjects("TextBox3").Object.Value = ActiveSheet.OLEObjects("ListBox1").Object.Selection
ActiveSheet.OLEObjects("ListBox1").Object.Selection = ""
End Sub
Any thoughts on how to make this word or resources to search are appreciated.
Your code would be cleaner written like this:
Private Sub ListBox1_Click()
TextBox1.Value = ListBox1.Text
ListBox1.Selected(ListBox1.ListIndex) = False
End Sub
But there is a problem: the second line doesn't work inside the ListBox1_Change event (because it would create an infinite loop). I tried with Application.EnableEvents = False, but it didn't help.
I think you need to put the reset of the selection in another event, like the KeyUp or MouseUp.

Make vba code work for all boxes

Hello so what i want to do is make this code work for all Check Box's 1-50 I want the code to only effect the box that is clicked.
Private Sub CheckBox1_Click()
If MsgBox("Do you want to lock this box?", vbYesNo, "Warning") = vbYes Then
ActiveSheet.CheckBox2.Enabled = False
Else
End If
End Sub
I see several options (none of which are pretty since this is VBA).
Option 1: generate the code for all of your check boxes. This is probably the most maintainable. You would first choose reasonable names for all your check boxes (you can assign them by selecting them in Excel and renaming in the top left corner, or run code which will do this for you if you already have a lot of check boxes. This may be useful).
You can then generate the code and have each one of your subprocedues as follows:
'example code for one checkbox
Private Sub chkBox_1_Click()
Call lockMeUp(Sheet1.chkBox_1.Object)
End Sub
After you're done with all your code for each checkbox, you could have your lockMeUp subprocedure as follows:
Sub lockMeUp(chkBox as Object)
If MsgBox("Do you want to lock this box?", vbYesNo, "Warning") = vbYes Then
chkBox.Enabled = False
End If
End Sub
Option 2: Keep track of all your checked/unchecked statuses through either an Array or a "Settings" hidden sheet, and watch out for that triggered event. You could fire off based off of a sheet's Changed event, and match the row number to your CheckBox number so that you can go off of the Target's row number.
Other options I can think of become more convoluted... I'd be interested to see what other suggestions people have. Thanks!
EDIT You can use some code to refer to a single function as in my example, in conjunction with brettdj's example to get your optimal solution. Bam!
The easy way is to write a class module that will apply one code routine to a collection of Checkboxes
Assuming yu want to run this on all ActiveX checkboxes on the ActiveSheet, then borrowing heavily from Bob Phillip's code from VBAX
Insert a Class Module named clsActiveXEvents
Option Explicit
Public WithEvents mCheckboxes As MSForms.CheckBox
Private Sub mCheckboxes_Click()
mCheckboxes.Enabled = (MsgBox("Do you want to lock this box?", vbYesNo, "Warning") = vbNo)
End Sub
In a normal module use this code
Dim mcolEvents As Collection
Sub Test()
Dim cCBEvents As clsActiveXEvents
Dim shp As Shape
Set mcolEvents = New Collection
For Each shp In ActiveSheet.Shapes
If shp.Type = msoOLEControlObject Then
If TypeName(shp.OLEFormat.Object.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckboxes = shp.OLEFormat.Object.Object
mcolEvents.Add cCBEvents
End If
End If
Next
End Sub
In case you do not know, all Form Controls are treated as Shapes in a Worksheet.
I have a solution that you need to create a new Module, copy-paste in code below and then from Immediate window to the same module. With some assumptions:
All Check Box Objects are named "Check Box #" where # is a number
No macro named ResetCheckBoxes() in any other modules of the workbook
No macro named CheckBox#_Click() in any other modules of the workbook
Run this ResetCheckBoxes once to enable check boxes and Assign a macro to it for you, with relevant generated codes in the immediate window (you might want to put a pause in the loop every 25 check boxes as line buffer in it are limited).
Sub ResetCheckBoxes()
Dim oWS As Worksheet, oSh As Shape, sTmp As String
Set oWS = ThisWorkbook.ActiveSheet
For Each oSh In oWS.Shapes
With oSh
If .Type = msoFormControl Then
If InStr(1, .Name, "Check Box", vbTextCompare) = 1 Then
.ControlFormat.Enabled = True
sTmp = "CheckBox" & Replace(oSh.Name, "Check Box ", "") & "_Click"
.OnAction = sTmp
Debug.Print "Sub " & sTmp & "()"
Debug.Print vbTab & "ActiveSheet.Shapes(""" & .Name & """).ControlFormat.Enabled = False"
Debug.Print "End Sub" & vbCrLf
End If
End If
End With
Next
End Sub
Example Immediate window output (2 test check boxes):
Happy New Year mate!
To build on the solution offered by #brettdj, since he is specifying ActiveX Controls, I would suggest the following in the Standard Module:
Dim mcolEvents As Collection
Sub Test()
Dim cCBEvents As clsActiveXEvents
Dim o As OLEObject
Set mcolEvents = New Collection
For Each o In ActiveSheet.OLEObjects
If TypeName(o.Object) = "CheckBox" Then
Set cCBEvents = New clsActiveXEvents
Set cCBEvents.mCheckboxes = o.Object
mcolEvents.Add cCBEvents, o.Name
End If
Next
End Sub
The differences are:
I use the OLEObjects Collection because it is more direct and doesn't waste time on non-OLE shapes.
I use TypeName instead of (the mysterious) TypeOf operator because (apparently) the later does not discriminate between OptionButton and CheckBox.
I register the Object Name as Key in the Collection to allow for efficient indexing if required.
EDIT:
I should have followed the link provided by #brettdj before posting. My solution is using the same principles as are outlined there. Hopefully, its convenient to have it documented here as well?

Resources