I'm creating a macro to add a menu button to a selected Visio shape object, so whenever the user right-clicks on the box, an option will appear and will call a macro. I created a couple of properties to the object, which will be used by the action to be called.
I can do it (SUCCESSFULLY) manually by using the ShapeSheet editor -> View Sections -> Actions -> and configuring the action with the Action value of
=CALLTHIS("ThisDocument.myFunction",,Prop.IPAddress)
sub myFunction (shpObj as Visio.shape, strIPAddress as String)
'working code with the functionsI want it to do. here I use the strIPAddress passed as an argument
What I'm trying to do is automate this by creating a macro that does the same:
Public Sub AddActionToShape()
Dim vsoShape1 As Visio.Shape
Dim intActionRow As Integer
'Performs this action to the selected item
Set vsoShape1 = Application.ActiveWindow.Selection(1)
'create row in the action section (http://office.microsoft.com/en-gb/visio-help/HV080902125.aspx)
intActionRow = vsoShape1.AddRow(visSectionAction, visRowLast, visTagDefault)
'add action to the row (http://msdn.microsoft.com/en-us/library/office/ff765539(v=office.15).aspx)
'HERE IS THE PROBLEM
**vsoShape1.CellsSRC(visSectionAction, intActionRow, visActionAction).FormulaU = """myFunction(vsoShape1, vsoShape1.Prop.IPAddress)"""**
vsoShape1.CellsSRC(visSectionAction, intActionRow, visActionMenu).FormulaU = """My Function"""
End Sub
My question:
What value should I put on the FormulaU to refer to a sub routine defined in my macro, while passing parameters. If I should not be using this FormulaU attribute, please point me to the correct one.
I ended up doing it like this and it works just fine.
Dim formula As String
formula = "=CALLTHIS([MODULE],,[ARG1],[ARG2])"
formula = Replace(formula, "[MODULE]", Chr(34) & "ThisDocument.myFunction" & Chr(34))
formula = Replace(formula, "[ARG1]", "Prop.IPAddress")
formula = Replace(formula, "[ARG2]", "Prop.Username")
'After the formula has been created, apply it to the row
shape.CellsSRC(visSectionAction, rowBeingEdited, visActionAction).formula = formula
You should set FormulaU exactly to the content to which you set it manually. That is, to
CALLTHIS("ThisDocument.myFunction",,Prop.IPAddress)
Try:
vsoShape1.CellsSRC(visSectionAction, intActionRow, visActionMenu).FormulaU = _
"CALLTHIS(""ThisDocument.myFunction"",,Prop.IPAddress)"
Related
I am having an userform where I have 8 Checkboxes in it.
Each checkbox is assigned to an call function called autofilter.
I would like to have an vba,in such a way that more than one Checkbox is used, then it should Display the result of selected Checkbox.
How can I achieve in VBA. I am struck how i should proceed with this Problem.
Expecting an help from Forum.
This is my autofilter program
Sub autofilter()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Result")
wslr = ws.Cells(Rows.Count, 1).End(xlUp).Row
Set myfilt = ws.Range("A1:AFU" & wslr)
myfilt.autofilter Field:=12, Criteria1:= _
"USA"
End Sub
similarly, i have them for other Locations as well till autofilter7.
Right now, i have the code working in such a way that, if check box 1 is true it calls autofilter1.
I would like to have a VBA, in such a way that, when i select 1 or more checkboxes, it should call their autofilter function together. How can i achieve this ?
[![I have userform with Checkboxes designed like this.in the command button i have the following code,
If CheckBox1.Value = True Then
Call autofilter
End If
similarly, I have it same for other checkboxes.
]1]1
Difficult to answer without all the exact details, but I think you are looking for something like:
In the command button _Click sub code, you should have this:
Edited : notice Dim i as String at the top.
Dim formControl As Control
Dim i As String
'loop through every control in the userform
For Each formControl In Me.Controls
'Test if the control is a checkbox
If LCase(TypeName(formControl)) = "checkbox" Then
If formControl.Value = True Then
'The below is very crude and you should find a better way of getting parameter from checkbox
'The below also assumes you use ONE filterFunction that takes a parameter
'You need to get the number from the checkbox, so take the number from the name of the checkbox
i = Right(formControl.Name, 1) - 1
'myFilterFunction i (Use this only if you have parameterised your function)
'change i to empty string if it was 0.
i = IIf(i = 0, "", i)
'This calls a function represented by the string
Application.Run "myFilterFunction" & i
End If
End If
Next formControl
At the moment, the away you've describe it, the code should work. Replace the name of the function with the name of your autofilter function....
I have a spreadsheet, basically a to-do list that has checkpoints marked by checkboxes. Rules for the checkboxes are:
1) Only the first checkbox (named checkbox_1) can be checked first.
2) Checkboxes can only be checked sequentially (i.e. checkbox_1, checkbox_2, checkbox_3 etc.)
Initially all checkboxes except for checkbox_1 are disabled. When an enabled checkbox is clicked, the next checkbox becomes enabled and disables the previous one.
The trouble I am having now is that double-clicking bypasses the enabled status of the checkbox and will go ahead and check the checkbox via the event handler.
How can I prevent this? Do I need to write something in the _BeforeDoubleClick event handler?
My event handler for the checkbox_click event is here:
Public Sub CheckBoxClick(Optional checkboxName As String = "")
'This calls the checkbox function to create the timestamp and enable the next visible checkbox
Dim assocTime As Range
Dim callerName As String
Dim aCaller As Variant
Dim check_num As String
Dim aCheckboxes As Variant
Set aCheckboxes = common.GetSheet(1).CheckBoxes
If checkboxName <> "" Then
callerName = checkboxName
Else
callerName = Application.Caller
End If
aCaller = Split(callerName, "_")
check_num = aCaller(1)
Set assocTime = common.GetRange("time_" & check_num)
If assocTime.value = "" Then
Call obj.ClickCheckBox(callerName, Constants.mypw)
End If
If check_num = aCheckboxes.count Then
If MainSheetFunctions.HasRedCells Then
common.MessageBox ("This batch record has cells with errors. Please address all red cells before continuing.")
Exit Sub
End If
End If
End Sub
The obj.ClickCheckBox sub will write the current time in an adjacent cell, and enable the next checkbox.
Thank you for your time,
I have a userform that opens on cell change in a column.
That userform contains checkboxes, which all trigger a second userform with a text box which looks up a cell on a hidden sheet for its contents. (The checkbox that's ticked determines which cell the textbox looks for). The user then edits the box, clicks a button, and the new text is written back to the same cell.
This is the VBA for when the checkbox is ticked. It works great. Hooray!
Dim vln As Variant
Dim reta As Worksheet
Set reta = ActiveWorkbook.Sheets("RetailerActivity")
Set vln = ActiveCell.Offset(-1, -3)
UserForm2.TextBox1.Text = Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False)
UserForm2.TescoSave.Visible = True
UserForm2.Show
End Sub
When the textbox has been edited, I would like to write it back to the same cell it came from. I figure the easiest way to do that is to have a public variable (as range), and to pass the result of the vlookup into that variable so the second userform can have a line which reads
Private Sub ASave_Click()
publicvariable.Value = TextBox1.Value
userform1.hide
End Sub
Nice and easy, rather than doing a VLookup again. Right?
Either way, I can't seem to set the public variable as the lookup.
Outside of any sub I have
Public bums As Range
And in the code above, after the bit where I've set the text box, I've tried to add the line
Set bums = Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False)
But the code errors with a "type mismatch".
If I try
Set bums = Range(Application.WorksheetFunction.VLookup(vln, reta.Range("A1:Z100"), 3, False))
I get method "Range" of object "_global" failed.
I code by cobbling bits off the internet, as you can probably tell, so this is I don't doubt a complete kludge.
Any advice would be super appreciated.
VLookup returns a value, not a Range. You could use Match to find the row and then Cells to get the actual reference - for example:
Dim vMatch
vMatch = Application.Match(vln, reta.Range("A1:A100"),0)
If Not IsError(vMatch) then
Set bums = reta.Cells(vMatch, "C")
else
msgbox "No match for " & vln
Exit Sub
End If
Personally I would also not use a public variable, but create a property for Userform2 to which you can assign the range.
I have been creating an acronym finding macro that will sit on a custom toolbar in word. When run it searches the document for acronyms and places them in a table. I want to include some user forms so that as the macro finds an acronym the user can select the predefined definition (got from an excel document) or enter their own new one (I know multiple acronyms meanings is frowned upon but it happens).
Anyway I am stuck. I have created a user form with three buttons. A text input and a label. Now I have managed to set the label text with the acronym that was found however I can't seem to get the buttons to change a variable, userChoice, and if applicable save the newly entered definition.
below is the test macro i have been trying this out on
Sub userFormTest()
Dim objExcel As Object
Dim objWbk As Object
Dim rngSearch As Object
Dim rngFound As Object
Dim targetCellValue As String
Dim userChoice As Integer
Set objDoc = ActiveDocument
Set objExcel = CreateObject("Excel.Application")
Set objWbk = objExcel.Workbooks.Open("C:\Users\Dave\Documents\Test_Definitions.xlsx")
objExcel.Visible = True
objWbk.Activate
With objWbk.Sheets("Sheet1")
Set rngSearch = .Range(.Range("A1"), .Range("A" & .Rows.Count).End(-4162))
Set rngFound = rngSearch.Find(What:="AA", After:=.Range("A1"), LookAt:=1)
If rngFound Is Nothing Then
UserForm1.Label1.Caption = "Acronym: AA" & vbCr & _
"Definition: Not found, please enter a definition below" & vbCr & _
" or choose to ignore this acronym"
UserForm1.Show
'an if statement here so that if the add button was pressed it adds to doc etc
Else
targetCellValue = .Cells(rngFound.Row, 2).Value
UserForm2.Label1.Caption = "Acronym: AA" & vbCr & _
"Definition: " & targetCellValue
UserForm2.Show
'an if statement here so that if the add button was pressed it adds to doc etc
End If
End With
objWbk.Close Saved = True
Set rngFound = Nothing
Set rngSearch = Nothing
Set objWbk = Nothing
objExcel.Visible = True
Set objExcel = Nothing
Set objDoc = Nothing
End Sub
I do realise that this could be done in the button_click() subs however I already have all the documents open etc in the other macro. Or is it possible to link to those already open documents? To be honest either way I would prefer to return to the main macro and just use the form to the user input.
I do realise that this could be done in the button_click() subs. However I already have all the documents open etc in the other macro. Or is it possible to link to those already open documents?
You can definitely link between button_click() subs and your main macro to modify the value of userChoice.
Answer:
What you need is some userform element (like a textbox) that can hold your value so you can refer back to it in your main macro. It looks like you already have this element (based upon your caption "Not found, please enter a definition below"). Let's say that element is a TextBox called Definition. Then let's say you want to return to the main macro after people push an "Add" button, as it appears you do (based upon your comment "so that if the add button was pressed it adds to doc").
In each of both Userform1 and Userform2, you would want something like this:
Private Sub AddButton_Click()
Userform1/Userform2.Hide
End Sub
That would return you to your main macro, where you could follow up with:
If Userform1/Userform2.Definition.Value = Whatever Then
'if the add button was pressed it adds to doc etc
End If
right where your existing comments are. Note that you could set userChoice = Userform1.Definition.Value here, but you don't need to because Userform1.Definition.Value already contains the information you need to track.
Additional material:
Rather than using the default instance of your Userform1 and Userform2 by using .Show on them immediately without assigning new instances of them to variables, may I suggest creating Userform variables to contain New instances of them like this:
Dim UnknownDefinition As Userform1
Set UnknownDefinition = New Userform1
UnknownDefinition.Show
Or if you want to get really optimal, you could follow more of the approach recommended here on how to make a properly instanced, abstracted userform:
Rubberduck VBA: How to create a properly instanced, abstracted userform
And now with bonus quotes from the post's author, #Mathieu Guindon:
make Definition a proper property, with the Property Let mutator changing the label value on top of changing its private backing field's value; avoid accessing form controls outside the form, treat them as private even if VBA makes them public.
Calling code wants data, not controls. You can extract properties/data, but not controls, into a dedicated model class.
So, this is basically what I'm trying to do. I have a column of employee #'s in a file that's generated from MSSQL. I want to create a function in a cell where the URL would be, http://www.someplace.com/employee.php?ID=Employee#FromCell
So far all of the examples that I've found aren't detailed enough for me to figure out what to do with it. I know this isn't correct, but this is what I ended up with so far
Function openurl(strSKU As String)
ActiveWorkbook.FollowHyperlink Address:="http://www.someplace.com/employee.php?ID=?strSKU=" & strSKU, NewWindow:=True
End Function
I think I'm mixing up methods with functions but I'm not sure where to go with it. I basically want to add it in as a function to make it easier to insert into the column.
I see someone provided you with a work-around for accomplishing this, but I'll give you the method you were asking for (just in case). FYI the intellisense sucks in VBA when referencing OLE objects (i.e., some methods may not appear to belong to the button objects, but they do).
The script below will create the buttons for you automatically, and will send the user to the site you specified when clicked. **I included notes which explain what each line does.
This creates the buttons in columns B and gets the URL parameter from column A:
Sub CreateButtons()
Dim btn As Button 'Create a variable for our button
Application.ScreenUpdating = False 'Speed up the process by disabling ScreenUpdating
ActiveSheet.Buttons.Delete 'Delete existing buttons.
Dim Report As Worksheet 'Create our worksheet variable.
Set Report = Excel.ActiveSheet 'Set our worksheet to the worksheet variable.
Dim t As Range 'Create a variable for the cells we will reference.
For i = 1 To Report.UsedRange.Rows.Count 'This will loop through each row in the used range of our worksheet.
If Report.Cells(i, 1).Value <> "" Then 'If the value of the first cell is not empty, then do the following...
Set t = Report.Range(Cells(i, 2), Cells(i, 2)) 'Assign the cell in the second column of the current row to the cell variable.
Set btn = Report.Buttons.Add(t.Left, t.Top, t.Width, t.Height) 'Create a button and place it in the cell in the second column.
With btn
.OnAction = "openurl" 'Set the button to trigger the openurl sub-routine when it is clicked.
.Caption = Report.Cells(i, 1).Value 'Set the caption of the button to equal the value of the cell in the first column.
.Name = i 'Set the name of the button to equal the row on which it resides. This name will be used in the openurl sub; So don't change it.
End With
End If
Next i
End Sub
This is the macro performed when the user clicks a button:
Sub openurl()
Dim Report As Worksheet 'Create a variable for the worksheet
Set Report = Excel.ActiveSheet 'Assign the worksheet to our variable
Dim i As Integer 'Create a variable for our row number
i = Application.Caller 'Assign name of the button to our row number.
Dim address As String 'Create a variable for our address
address = "http://www.someplace.com/employee.php?ID=?strSKU=" & Report.Cells(i, 1).Value 'Assign the URL to our address variable.
ActiveWorkbook.FollowHyperlink address:=address, NewWindow:=True 'Send the user to the URL you specified (with the URL parameter at the end).
End Sub
BONUS INFO:
Follow the next step to have the entire process done for you automatically:
When you say the current data is populated from a MSSQL database, you probably mean you are pulling the data into Excel using another VBA sub or function. If so, then if you place a script to call the "CreateButtons()" subroutine after the script that pulls the data, this entire process will be done for you automagically. Example:
Sub getEmployeeData() 'This represents your sub that pulls your data from MSSQL
'================================================================
'This represents your script to get your information into Excel.
'================================================================
Call CreateButtons 'This runs the CreateButtons() subroutine.
End Sub
Enjoy!
You can do this without VBA. You can use a formula.
=Hyperlink("http://www.someplace.com/employee.php?ID="&A1,A1)
Where A1 would have the employee ID.
Check out this post I made about creating hyperlinks from External Data:
http://www.spreadsheetsmadeeasy.com/creating-hyperlinks-with-external-data/
Scroll down to the "Add Hyperlinks" section for more info.