Excel VBA add hyperlink to shape to link to another sheet - vba

I have a macro that creates a summary sheet at the front of a Workbook. Shapes are created and labeled after the sheets in the workbook and then hyperlinks are added to the shapes to redirect to those sheets, however, when I recorded the macro to do this, the code generated was:
ActiveSheet.Shapes.Range(Array("Rounded Rectangle 1")).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection.ShapeRange.Item(1), Address:=""
The hyperlinks that were manually created in excel while recording the macro work just fine and when hovering over them, display the file path and " - Sheet!A1" but they don't seem to actually be adding the link location into the address portion of the macro. Does anyone know the code that should go in that address section to link to the sheet?

The macro recorder doesn't record what is actually happening in this case. The property you are looking for is SubAddress. Address is correctly set in your code.
Create a hyperlink from a shape without selecting it
You want to avoid selecting things in your code if possible, and in this case it definitely is. Create a shape variable and set it to the shape you want to modify, then add the hyperlink to the sheet the shape is on. Note that you can also set the text for the screen tip.
In the example below, the shape I want to modify is on Sheet 6, and hyperlinks to a range on Sheet 4.
Sub SetHyperlinkOnShape()
Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("Sheet6")
Dim hyperLinkedShape As Shape
Set hyperLinkedShape = ws.Shapes("Rectangle 1")
ws.Hyperlinks.Add Anchor:=hyperLinkedShape, Address:="", _
SubAddress:="Sheet4!C4:C8", ScreenTip:="yadda yadda"
End Sub

Related

Excel VBA Allow user to select an already open workbook and attach variables to selected workbook

With Excel 2013 VBA, I am familiar with setting the value of a Workbook variable with:
Set oWBSource = Workbooks.Open(strFileToOpen) 'Works well.
In my situation though, sometimes the Workbook is already open on the desktop. I am trying to find a more elegant way to "select" that spreadsheet and then attach my variable to that workbook to operate on. The code is running on a separate "master" spreadsheet.
Currently, I am asking the user if the file is already open. If so, then:
Dim rng As Range
Set rng = Application.InputBox("Select any cell on workbook to operate on.", "Click Workbook Cell", Type:=8) 'Stops code and allows user to select a cell on an open spreadsheet
Dim sTest As String 'variable used to test.
sTest = ActiveCell.Value 'Testing to see what value code is seeing.
sTest = ActiveWorkbook.Name 'Testing to see what value code is seeing
Set oWBSource = Workbooks(ActiveWorkbook.Name) 'Works if selected Workbook is maximized and minimized.
If I run the above code and when it runs the inputbox, if I click one cell on the spreadsheet I want the code to operate on and allow the code to continue, the variables still reference the Workbook where the code resides rather than the "selected" workbook. If, while selecting one cell, I also maximize and minimize the spreadsheet (basically Activate it) and then click a cell and allow the code to continue, the active spreadsheet is set and it seems to work. I realize the cell reference is doing nothing. But the pause allows me to "Activate" the desired spreadsheet.
I am looking for a more elegant way to handle attaching my code to an already open spreadsheet. My current solution is clunky. Isn't there a way to have the user select the open spreadsheet and then have my code "act" on that spreadsheet?
I know this is a weird question. Be kind rating it please??!!
If I understand correctly what you're trying to do, just use the rng to resolve the selected Workbook:
Set oWBSource = rng.Parent.Parent
rng.Parent is the Worksheet a Range is a part of, and the .Parent of a Worksheet is its Workbook.

Excel Macro - Run Against Another Workbook

Good Morning All,
I'm just trying to understand how to run a macro that is in one workbook but apply the macro procedure/changes into another workbook that is open.
What I am trying to achieve is one workbook is say the Template that will always be open. I have a macro in that Template file that works through a directory looking for xlsm files and opens them one at a time. What I want to do is when the workbook is opened another macro is called in the Template file which updates connection string details in the other open workbook.
I have the macros ready and they work, but I want to run them against another workbook without having to copy the code into it.
Is this at all possible?
Thanks in advance.
Make a variable to store your workbook, then use it to refer to it. Something like this:
'place this at the top of the module so that the variable can be used by all macros
Private wb As Workbook
'place this in your "browse and open" macro in place right after you open a workbook
Set wb = ActiveWorkbook
'now you can do whatever you want by referring to wb
wb.Worksheets("Sheet 1").Range("A1") = "Cell A1"
wb.Worksheets("Sheet 2").Range("C3").EntireRow.Delete
wb.Close
You could also continue referring to ActiveWorkbook, but you have to make sure that it actually remains active all the time you want to work on it. If in the meantime you want to do something on your template workbook, you can refer to it as ThisWorkbook.
Sub h()
'ask for row number >>
k = InputBox("witch row?")
' you now define the worksheet >>
Sheet2.Select
'now you see that in this case i used a selected cell as point of reference>>
Sheet2.Range("a" & k).EntireRow.Delete
End Sub
In MS EXCEL Sheet1, go to "Insert tab", to "shapes",>>
select a rounded cornered box, add a text to it so its intuitive,>>
change the colors of text and background, then :>>
select the shape you created with the mouse with a "right click">>
and from the list that appears select "Assing Macro", and select macro "h"
if all goes to theese indications, we have the next step >>
if u click it it runns the sub. and therefor you will be presented with a inputbox, where you specify the row number you want to be deleted.
there you go!
p.s. hoping im clear.

Hyperlink directs to hidden row

I have a workbook that has 2 sheets. Sheet 1 has hyperlinks to several different cells in Sheet 2. The issue is that there are filters in Sheet 2 that will hide rows, so when you try to follow the hyperlink from Sheet 1, the row is hidden and you can't see the target. I'm trying to figure out how to do the following:
On clicking a hyperlink, determine the target row in Sheet 2
If target row is hidden, unhide the target row in sheet 2, then follow the hyperlink.
It can stay unhidden after the hyperlink is followed, I'm fine with that. I've struggled with this for the past several days, and have come up with nothing successful. I've tried the "Followhyperlink" function, but I think this is too late - it's already followed the hyperlink, so unhiding the row at that point is too late.
Any suggestions? I'm stumped!
FollowHyperlink is indeed the event handler to use. Put this code in the worksheet module for Sheet1:
Option Explicit
Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)
Dim hyperlinkParts() As String
If ((Target.Type = msoHyperlinkRange) And (Target.SubAddress <> "")) Then
If (InStr(Target.SubAddress, "!") > 0) Then
hyperlinkParts = Split(Target.SubAddress, "!")
If ((Left$(hyperlinkParts(0), 1) = "'") And (Right$(hyperlinkParts(0), 1) = "'")) Then
hyperlinkParts(0) = Mid$(hyperlinkParts(0), 2, Len(hyperlinkParts(0)) - 2)
End If
Worksheets(hyperlinkParts(0)).Range(hyperlinkParts(1)).EntireRow.Hidden = False
End If
End If
End Sub
This checks that the hyperlink corresponds to a Range object then splits the target address into the sheet name and the specific cell(s). It then unhides the row(s) which correspond to the target address.
The check for the subaddress being empty is needed for hyperlinks to an external workbook where no particular cell is specified
edit: this approach won't work for hyperlinks to named ranges and I've altered the code to avoid getting an error message with that kind of hyperlink
edit2; code revised to deal with worksheet names containing spaces which were previously causing an error

how to create relative path in hyperlink excel ? (Word.Document.12)

I have two documents, one which has all the info and it is a word document, and another that is an excel document, that have just some highlights from the word document.
I want to create some links between some selected text in word and excel cells, so far the special past is doing a great job, and create link in this format
=Word.Document.12|'C:\Users\...\xxx.docx'!'!OLE_LINK9'
Now i want to copy both documents in my usb and past them in other computers, this where the problem is, i would have to do the special past all over again since the path is different now, what i though as a solution was to put the path to the word document in cell let say A1 and concatenate the formula above, something like
=Word.Document.12|A1!'!OLE_LINK9'
but it doesnt work, it throws an error message, can you please help me?
PS : I would like to avoid vba if possible
PS : I would like to avoid vba if possible
I have included both ways to do it since the question is tagged with Excel-VBA as well :)
Take your pick.
VBA Way
Is this what you are trying?
Sub Sample()
Dim objOle As OLEObject
'~~> Change this to the respective Sheet name
With ThisWorkbook.Sheets("Sheet1")
'~~> This is your embedded word object
Set objOle = .OLEObjects("Object 1")
'~~> Cell A1 has a path like C:\Temp\
objOle.SourceName = "Word.Document.12|" & .Range("A1").Value & "xxx.docx!'"
End With
End Sub
Non VBA Way
Create a named range and call it say Filepath. Set the formula to
="Word.Document.12|'" & Sheet1!$A$1 & "xxx.docx'!'"
Where Cell A1 will have the file path.
Next Select your word document and in the formula bar, type =Filepath and you are done.

Excel VBA Copy and reposition logos across multiple worksheets

I'm currently looking to put together a simple excel workbook filled with several dozen template forms we use (one per worksheet). As part of this I am looking to have a "master" sheet at the front which can with the press of a macro copy information into all the other worksheets.
Doing this for the cells has been easy, but I have had limited success in copying across any logos. My intention is to put my company's logo at the top right of the form and any client logos at the top left, hit a button and the 2-3 logos will appear in the same place across all the other worksheets.
I've managed to reposition the logos individually by name with the following code:
For Each Shape In Worksheet.Shapes
If Shape.Name = "OurLogo" Then
Shape.Left = (Wb1.Sheets("Inputs").Shapes("Our Logo").Left - 1)
Shape.Top = (Wb1.Sheets("Inputs").Shapes("Our Logo").Top - 1)
End If
Next Shape
Where Our Logo is the original logo and OurLogo is the copied and named logo.
However this means I need the logos already copied into the correct cell in each workbook with the correct name. I've managed to copy the logo across all the worksheets, but not been able to rename them as I've been going, they are just assigned "Picture#" as a name. I tried including a rename in a similar "For Each" macro to copy it across all the sheets, but this only renamed one logo pasted into the active worksheet and didn't rename any in the remaining worksheets.
Any advice on how to copy and rename these pictures to multiple worksheets while also renaming them would be greatly appreciated. Alternatively I would accept copying first and a method of renaming after with a second macro.
Thanks in advance for your help.
I previously tried the How to copy a Shape to another worksheet (not as a picture)?, method but setting the destination cell simply dumped the logo in the top left corner, looking very untidy when I wanted it centred - hence the repositioning macro based on the position of the original logo. The method under that link also renamed the logo to "Picture#", creating the renaming requirement.
The 2nd result when Googling for "Excel VBA shape copy" point to a nifty question here at SE.
How to copy a Shape to another worksheet (not as a picture)?
Pretty sure that will solve your problem.
i have done this with 1 shape
Sub CopyAndRenameShape()
Dim sh As Shape
Dim wks As Worksheet
Set sh = Sheet1.Shapes("shtTest")
For Each wks In ThisWorkbook.Worksheets
If wks.Name <> ActiveSheet.Name Then
sh.Name = wks.Name & "_" & sh.Name
sh.Copy
wks.Paste
End If
Next wks
sh.Name = "shtTest"
End Sub