is there a way to add a hyperlink, provided from a cell, to an image?
I tried the following VBA code:
Sub Storage_Test_Click()
ActiveSheet.Hyperlinks.Add Anchor:=storage_image, Address:=Worksheets("Links").Range("B8:B8").Value
End Sub
But with this piece of code, the link is persistent. In other words, if I change the cell value, the link from the image is not affected.
Thanks,
Tro
Enter something like this in a Module
Sub Add_HLink(ws As Worksheet, picture_name As String)
Dim sh As Worksheet: Set sh = Worksheets("Link")
Dim shp As Shape
For Each shp In ws.Shapes
If shp.Type = msoPicture And shp.Name = picture_name Then
ws.Hyperlinks.Add shp, sh.Range("B8").Value
Exit For
End If
Next
End Sub
Then in your Link Sheet:
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo halt
Application.EnableEvents = False
If Not Intersect(Target, [B8]) Is Nothing Then
'~~> use the sub here, assuming Picture named "Picture 1" is in Sheet2
Add_HLink Sheet2, "Picture 1" '~~> change the arguments to suit
End If
continue:
Application.EnableEvents = True
Exit Sub
halt:
MsgBox Err.Description
Resume continue
End Sub
Is this what you're trying? HTH.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
ActiveSheet.Hyperlinks.Add Anchor:=storage_image, Address:=Worksheets("Links").Range("B8:B8").Value
End Sub
dont assign the macro to the image, because you can't click on the image (as it's a hyperlink!), if you right click your image with your original code after updating your link, im sure that selects it and your macro will run, however the above changes should mean everytime you make a selection on your sheet, your links will update
Related
I am trying to write a macro where i can equate the name of a worksheet to a cell value.
So far i have only been able to extract name of the worksheet and put it to a cell value.
Is there a way i can achieve the above?
Thanks
There is already a solution to this,
Follow this link
Credit to folks at Extendoffice.com
Pasting code here for reference, just follow the link you'll find details
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Set Target = Range("A1")
If Target = "" Then Exit Sub
Application.ActiveSheet.Name = VBA.Left(Target, 31)
Exit Sub
End Sub
You can easily achieve this with the Worksheet_Change event of the worksheet.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'note that A1 here is the cell that contains the sheet name. Adjust it to your needs.
If Target.Address(False, False) = "A1" Then
Target.Parent.Name = Target.Text
End If
End Sub
Every time the value of A1 changes, the worksheet name changes accordingly.
Note this procedure has to be in a worksheet scope not within a module.
It can be useful to implement an error handling for not allowed or empty sheet names.
Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
'note that A1 here is the cell that contains the sheet name. Adjust it to your needs.
If Target.Address(False, False) = "A1" And Target.Text <> vbNullString Then
On Error GoTo ERR_NO_RENAME
Target.Parent.Name = Target.Text
On Error GoTo 0
End If
Exit Sub
ERR_NO_RENAME:
If Err Then MsgBox Err.Description, vbCritical, Err.Number, Err.HelpFile, Err.HelpContext
End Sub
I want a macro that creates a textbox in Worksheet2 when I write something in Worksheet1!A1. The problem is that I want it to refresh whenever I refresh the data.
I made one but is runs the macro again, so I am left with several textbox, one on top of the others. Also I want to delete the textbox if the cell is empty.
I would appreciate any help. Thanks. Here is my code:
Sub criarcaixastexto()
Dim wsActive As Worksheet
Dim box As Shape
Set wsActive = Worksheets(2)
Set box = wsActive.Shapes.AddTextbox(msoTextOrientationHorizontal, 20, 20, 100, 50)
box.TextFrame.Characters.Text = Range("Folha1!A1").value
End Sub
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Address = "$A$1" Then
Call criarcaixastexto
End If
End Sub
To ignore empty values change the event to this one:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Count > 1 Then Exit Sub 'to avoid multiple selection.
If Target.Address = "$A$1" Then
RemoveShapes
If Len(Target) > 1 then Criarcaixastexto
End If
End Sub
This will remove the shapes, before writing new ones.
Sub RemoveShapes()
Dim shp As Shape
For Each shp In Worksheets(2).Shapes
If shp.Type = msoTextBox Then shp.Delete
Next shp
End Sub
I have data in column "AK" and a button in Column "AL"; there are several hundred rows and there is only one macro for all buttons as it uses relative references based on the row it is in.
I want the button to only be visible when there is data in the adjacent cell. The following pseudo-code explains what I am trying to achieve:
Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Column = 37 Then
If Target.Value = 0 Then
Shapes(Target.offset(0, 1)).Visible = False
Else
Shapes(Target.offset(0, 1)).Visible = True
End If
End If
End Sub
The reason for doing this is that the value in AK is calculated based on other values and only displays once all mandatory fields have been completed. The button should only be available for an automation task once all details are complete. What real code would make this work without having to call each button out individually?
I'm not sure if you can directly reference a shape by its location on the sheet.
This code will look at each shape until it finds the one to the right of the cell you've just changed, it will then change the visibility based on the contents of the cell.
(Target.Value <> "") returns TRUE/FALSE.
This will only work if your buttons are placed in the correct cell (slightly too high and it will return the cell above).
Private Sub Worksheet_Change(ByVal Target As Range)
Dim shp As Shape
For Each shp In ThisWorkbook.Worksheets("Sheet1").Shapes
If shp.TopLeftCell.Address = Target.Offset(, 1).Address Then
shp.Visible = (Target.Value <> "")
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
End Sub
Edit:
I've updated the code so it checks that only a single cell has been changed and then looks at each dependent cell of the cell that was changed.
This will probably muck up if the dependent cell is on another sheet though.
Private Sub Worksheet_Change(ByVal Target As Range)
Dim rUpdated As Range
Dim shp As Shape
Dim rCell As Range
If Target.Cells.Count = 1 Then
'Hopefully someone will have better code than On Error....
On Error Resume Next
Set rUpdated = Range(Target.Dependents.Address)
On Error GoTo 0
If Not rUpdated Is Nothing Then
'Look at each dependent cell in rUpdated.
For Each rCell In rUpdated
'Look at each shape in the sheet and cross-reference with rCell.
For Each shp In Target.Parent.Shapes
If shp.TopLeftCell.Address = rCell.Offset(, 1).Address Then
shp.Visible = (Target.Value = 0)
Exit For 'Exit the loop - the correct button has been found.
End If
Next shp
Next rCell
End If
End If
End Sub
NB: I got the idea for checking the dependent cell from here: How can I run a VBA code each time a cell get is value changed by a formula?
I'm trying to create a macro where it will switch from Sheet1 to Sheet2 when the word "Yes" is typed in any cell in column A. The closest I've come to getting this to work is with the code below that switches worksheets when "Yes" is typed in a specific cell.
Sub ifs()
If Worksheets("Sheet1").Range("A1").Value = "Yes" Then
Sheets("Sheet2").Select
Else
End If
End Sub
Like I mentioned that you can create a hyperlink in Cell A1 which will directly take you to Sheet2 but still if you want vba code then try this. This code will go into the sheet code area of Sheet1
Private Sub Worksheet_Change(ByVal Target As Range)
On Error GoTo Whoa
If Target.CountLarge > 1 Then Exit Sub
Application.EnableEvents = False
If Not Intersect(Target, Columns(1)) Is Nothing And _
UCase(Target.Value) = "YES" Then _
ThisWorkbook.Sheets("Sheet2").Activate
Letscontinue:
Application.EnableEvents = True
Exit Sub
Whoa:
MsgBox Err.Description
Resume Letscontinue
End Sub
NOTE: If you are interested in the Hyperlink approach then THIS is worth visiting. Checkout the section Create a hyperlink to a specific location in a workbook
Sub ifs()
If WorkSheetFunction.CountIf(Worksheets("Sheet1").Range("A:A"),"Yes") > 0 Then
Sheets("Sheet2").Select
End If
End Sub
Sub aaGraphing()
'
' aaGraphing Macro
'
'
Range("L948:W949,D948:D949").Select
Range("D949").Activate
ActiveSheet.Shapes.AddChart.Select
ActiveChart.ChartType = xlLineMarkers
ActiveChart.SetSourceData Source:=Range( _
"Analytics!$L$948:$W$949,Analytics!$D$948:$D$949")
End Sub
This code creates a chart of the data I want. Is there a way to way to make the created chart temporary so that when you click anywhere outside of the chart it deletes?
You could use the SelectionChange event of the worksheet to delete the chart. Below I am assuming there is only one shape - the chart - that might be on the worksheet.
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Me.Shapes.Count = 1 Then
Me.Shapes(1).Delete
End If
End Sub
It is possible (I believe) to dynamically attach this event, and remove it. However, I believe that it is a little complicated.
An alternative might be to use Application.OnTime to delete it after a period of time.
Application.OnTime Now + TimeValue("00:00:40"), "ProcedureToDelete"
will run the procedure named 'ProcedureToDelete' after 40 seconds. In this procedure you might want to make sure the the selection is in the worksheet, not in the chart that you are about to delete.
You could, in the timed-procedure, check to see if the chart is currently selected. If not, delete it, otherwise set the timer again.
Regular module....
Option Explicit
Public PlotName As String
Public PlotRange As Range
Sub Tester()
AddPlot ActiveSheet.Range("B3:B7,D3:D7")
End Sub
Sub AddPlot(rng As Range)
With ActiveSheet.Shapes.AddChart
PlotName = .Name
.Chart.ChartType = xlLineMarkers
.Chart.SetSourceData Source:=Range(rng.Address())
End With
Set PlotRange = rng
Application.EnableEvents=False
rng.Select
Application.EnableEvents=True
End Sub
Sub RemovePlot(rng As Range)
If Not PlotRange Is Nothing Then
If Application.Intersect(rng, PlotRange) Is Nothing Then
On Error Resume Next
rng.Parent.Shapes(PlotName).Delete
On Error GoTo 0
End If
End If
End Sub
Sheet code module:
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
RemovePlot Target
End Sub