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
Related
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = Range("B12").Address Then
Application.EnableEvents = False
Dim sOldValue As String, sNewValue As String
sNewValue = Target.Value
Application.Undo
Dim rOld As Range
Set rOld = Range("A1:E1").Value
Target.Value = sNewValue
Range("A15:E15").Value = rOld.Value
Application.EnableEvents = True
End If
End Sub
How to run this function, can you please call this function?
Create a button, add in the following code, you might need to change your code from Private to Public
`Private Sub CommandButton1_Click()
Call Worksheet_Change
End Sub`
The code you posted is for the Worksheet.Change event. The event occurs when cells on the worksheet are changed by the user or by an external link.
All you need to run this sub is to place the code in the sheet module for the relevant sheet and change B12 cell.
A Worksheet Change: Change Range Values on Cell Change
Worksheet_ in the signature Private Sub Worksheet_Change(ByVal Target As Range) indicates that this procedure belongs in the sheet module, e.g. Sheet1, of the worksheet where you want it applied (not in the ThisWorkbook module nor in a standard module, e.g. Module1). Such a procedure will run automatically (get triggered) when an event occurs, particularly for this procedure, after a manual change has happened in a range i.e. after
you write something into the formula bar and press enter,
you (copy) paste values to a range, or
you use VBA to write values to a range.
In this procedure, if you want to write something to a range of the worksheet, to not retrigger the event and possibly end up with an endless loop ('crashing' Excel), you will disable events before you start writing, and enable them after writing as you did in your code. If an error occurs between these two lines, the events will stay disabled and the code won't trigger until they are enabled again.
To check if events are enabled you could use the line Debug.Print Application.EnableEvents in another procedure or in the Immediate window just use ?Application.EnableEvents and press enter. Similarly, if the answer is False, in the Immediate window, you can use Application.EnableEvents = True and press enter to enable events.
The line Set rOld = Range("A1:E1").Value is wrong and results in
Run-time error '424': Object required
To avoid the error you could use one of the following:
Dim rgOld As Range: Set rgOld = Range("A1:E1")
Range("A15:E15").Value = rgOld.Value
Target.Value = sNewValue
Dim OldValues() As Variant: OldValues = Range("A1:E1").Value
Range("A15:E15").Value = OldValues ' or after the following line
Target.Value = sNewValue
Range("A15:E15").Value = Range("A1:E1").Value
Target.Value = sNewValue
Basically, you want to write the data before rewriting the new value. Optionally, in the second case where the data is written to an array (OldValues), you can write the values afterward.
Since the use of an additional variable is kind of redundant in the first two cases, the last (the simplest, the most straightforward) case is used in the following code.
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
Application.EnableEvents = True
End Sub
If you want to modify (experiment with) the code, you should introduce some error handling so you don't end up with events disabled.
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo ClearError
If Target.Address <> "$B$12" Then Exit Sub
Dim NewString As String: NewString = CStr(Target.Value)
Application.EnableEvents = False
Application.Undo ' this will also write (trigger the event)
Me.Range("A15:E15").Value = Me.Range("A1:E1").Value
Target.Value = NewString ' redo
SafeExit:
On Error Resume Next
If Not Application.EnableEvents Then Application.EnableEvents = True
On Error GoTo 0
Exit Sub
ClearError:
Debug.Print "Run-time error'" & Err.Number & "': " & Err.Description
Resume SafeExit
End Sub
One thing is basic: how did you create this function? Did you open the Excel VBA editor, select a sheet and chose the corresponding event, like I did in the following screenshot:
As you see, the macro is linked to "Sheet1", it is linked to the events of the "Worksheet" itself, and it is triggered by any "Change" of that worksheet.
I want to auto-run this private sub when opening the excel sheet.
I tried using Private Sub Workbook_Open() method but as the first private sub does not have a name, it does not work.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim ws As Worksheet: Set ws = Sheets("Budget- Reporting")
If Range("W6").Value = 0 Then
HideFG
Else
HideF
End If
End Sub
Sub HideF()
'
' HideF Macro
'
'
For i = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Visible = msoTrue
Next i
ActiveSheet.Shapes.Range(Array("F")).Visible = msoFalse
Application.CommandBars("Selection").Visible = False
End Sub
Sub HideFG()
'
' HideFG Macro
'
'
For i = 1 To ActiveSheet.Shapes.Count
ActiveSheet.Shapes(i).Visible = msoTrue
Next i
ActiveSheet.Shapes.Range(Array("FG")).Visible = msoFalse
Application.CommandBars("Selection").Visible = False
End Sub
I hope that it automatically checks cell W16 when opening the excel file and carries on with HideF macro or HideFG macro. Currently, the two macros run once you actual type on the cell after opening the file.
the easiest way is to use the default Module "ThisWorkbook" which gets executed when opening the excel file. You can find it within your VBA Project Explorer on the left side of the window.
Just take the sub you want to execute and copy it into the space.
Its explained in great detail here:
https://support.office.com/en-us/article/automatically-run-a-macro-when-opening-a-workbook-1e55959b-e077-4c88-a696-c3017600db44
If it is necessary for your usecase this can help you to call a private sub:
Private Sub PrivateCallDemo()
'Module2
Application.Run "Module1.Worksheet_Change"
End Sub
This way your actual Sub could stay in another Module.
You have a few problems. First you don't want Worksheet_Change(ByVal Target As Range)
as that is for events triggers on changes to the workbook, you want Workbook_Open(). This gets stored under ThisWorkbook not a separate module/sheet.
Here is working code, I commented out your ws declaration for testing.
Private Sub Workbook_Open()
'Dim ws As Worksheet: Set ws = Sheets("Budget- Reporting")
If Range("W6").Value = 0 Then
HideFG
Else
HideF
End If
End Sub
Sub HideF()
MsgBox "HideF"
End Sub
Sub HideFG()
MsgBox "HideFG"
End Sub
Here is a screenshot of my editor.
G.M. posted a great resource as well found here --> https://support.office.com/en-us/article/automatically-run-a-macro-when-opening-a-workbook-1e55959b-e077-4c88-a696-c3017600db44
I just put the modules in the same spot for the screenshot, but you can put them separately and still use the Call HideFG method if you want to store your modules separately from the workbook_open event as I would want to.
I am trying to use the following VBA macro to alter the content of a cell when a particular character is entered into it.
Sub replaceWords()
Dim i As Long
Dim r As Integer
For i = 1 To 60
For r = 1 To 60
If Cells(i, r).Value = "`" Then
Cells(i, r).Value = "0,0"
End If
Next r
Next i
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Target.Worksheet.Range("A1:AA100")) Is Nothing Then
Application.EnableEvents = False
Call replaceWords
Application.EnableEvents = True
End If
End Sub
My understanding is that Worksheet_Change should do this automatically, but it doesn't seem to be working - I have to run the macro manually. What am I doing wrong?
It's not clear from your code, but make sure Worksheet_Change is in the Worksheet object by going to the Project Explorer (Ctrl-R) and right click on the worksheet in question and select View Code. Put that worksheet_change module in there.
Make sure that the function is in the worksheet's module. If that still doesn't work, check to see if Application.EnableEvents is set to True.
You set that value to false as your code makes changes. If your code was interrupted before resetting it to True, the event driven subs won't fire.
Adding some error handling where you exit gracefully and reset EnableEvents to True is generally a good idea.
This is just an example of what I want to do. I have an elaborate macro that I want to do different things depending on whether it was called by another macro or not.
sub Example()
Call MyCode
end sub
sub MyCode()
If Called by Example GoTo SkipNextLine
Do these things
exit sub
SkipNextLine:
Do other things
end sub
You can create hidden name (which, actually, isn't tied to range). Think of it as global variable. The difference between global variable and this name is that name is persisted in workbook when you close it. When you open workbook again - you can start using it without any initialization. As a bonus, this name won't be displayed in Name Manager. The defining of name is required only once.
Sub SetHiddenName()
Names.Add Name:="Caller", RefersTo:="StartValue", Visible:=False
End Sub
Sub FF()
Names("Caller").Value = "FF"
Call SS
End Sub
Sub SS()
Select Case [Caller]
Case "FF": MsgBox "Called by FF" '...
Case "ZZ": MsgBox "Called by ZZ"
End Select
End Sub
A simple approach would be to use arguments and parameters.
Sub Example()
Call MyCode("Example")
End Sub
Sub Example2()
Call MyCode("Example2")
End Sub
Sub MyCode(Origin as String)
Select Case Origin
Case "Example"
'Do stuff here
Case "Example2"
'Do other stuff here
End Select
End Sub
I made my way to this post wanting a macro that changed things on the sheet, but not wanting to kick off event driven macros. In case it's also useful for someone else, it's possible to turn these off in excel using Application.EnableEvents in the parent macro using:
Sub parentMacro()
Application.EnableEvents = False
'Do stuf here
Application.EnableEvents = True
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
'this now only is called on worksheet changes outside of parent macro,
'as it's disabled while parent runs
'Note: This disables all event macros running, so might not be perfect for all cases
End Sub
I am looking to edit my current code as it is very long winded but if need be I can stick with it. My current code is simply repeated on each button as it runs through ActiveX buttons (these buttons must stay). Undo action is preferred but changing the colour back using RGB is a viable option.
My coding is as follows:
Private Sub btn3_Click()
Sheet1.Range("A84:J84").Interior.ColorIndex = 16
End Sub
This changes the cell range to a grey colour succesfully, I now need a double click to undo the action or something that will change the colours back to the original colour; I made two attempts.
Using undo function.
Private Sub btn3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Application.EnableEvents = False
Application.Undo
Application.EnableEvents = True
End Sub
Then I tried a different method and went to change the colour.
Private Sub btn3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Dim color_index As Long
color_index = 10
Sheet1.Range("A84:J84").Interior.Color(color_index) = RGB(153, 153, 255)
End Sub
End result was unsuccessful in both attempts.
Neither of these worked and would like a 'work around' or to fix my errors, any ideas accepted but I must keep buttons I cannot use 'Cell Selection'.
EDIT
If possible there my be an array method useable, I am not good with using ActiveX controls so any advice will most likely be very useful.
My workbook explaining what btn3 represents.
http://i.stack.imgur.com/35p2f.png
There's no easy way to do Application.Undo to undo the results of a macro-performed operation. You either need to create a cache/copy of the data and revert to that, or you need to formulate a way to "undo" in a custom function.
In any case, the error in your second method, this line:
Sheet1.Range("A84:J84").Interior.Color(color_index) = RGB(153, 153, 255)
Could eeither be changed to:
Sheet1.Range("A84:J84").Interior.ColorIndex = color_index
Or:
Sheet1.Range("A84:J84").Interior.Color = RGB(153, 153, 153)
Alternatively, you can do a custom undo function, something like this:
'## Module level variable
Dim previousColor As Long
Sub btn3_Click()
'## stores the current ColorIndex property of the range
' (assumes all cells have the same color)
previousColor = Sheet1.Range("A84:J84").Interior.ColorIndex
'## Applies the new color:
Sheet1.Range("A84:J84").Interior.ColorIndex = 16
End Sub
Sub btn3_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Sheet1.Range("A84:J84").Interior.ColorIndex = previousColor
End Sub
Further, you inquire:
as I updated is there a way to do this on a mass scale as I have 60+ 'buttons'...
Yes. Ensure firstly that all of the buttons call the same procedures. Then, modify the procedures for each button like below. NOTE I can't get the double-click to work without also invoking the single-click event, first, which has the undesired effect of not being able to "store" the previous color for the range. You may be able to add some conditional logic, for the time being I've hard-coded so the "undo" function will revert to no color at all:
Dim previousColor As Long '
Private Sub CommandButton1_Click()
Debug.Print "click"
Call changeColor(CommandButton1)
End Sub
Private Sub CommandButton1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "dbl click"
Call undoChangeColor(CommandButton1)
End Sub
Private Sub CommandButton2_Click()
Debug.Print "click"
Call changeColor(CommandButton2)
End Sub
Private Sub CommandButton2_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
Debug.Print "dbl click"
Call undoChangeColor(CommandButton2)
End Sub
Private Sub changeColor(btn As MSForms.CommandButton)
'Assumes all cells are same color initially
previousColor = -4142 '(none) 'Sheet1.Range("A84:J84").Interior.ColorIndex
'Get the row corresponding with each button:
Dim rng As Range
Set rng = Sheet1.Range("A" & btn.TopLeftCell.Row).Resize(1, 11)
rng.Interior.ColorIndex = 16 'Modify as needed
'you could assign the RGB() here
End Sub
Private Sub undoChangeColor(btn As MSForms.CommandButton)
'Get the row corresponding with each button:
Dim rng As Range
Set rng = Sheet1.Range("A" & btn.TopLeftCell.Row).Resize(1, 11)
rng.Interior.ColorIndex = previousColor
End Sub