Hyperlink Macro!

[MichaelRSnow]

Hello All, help please!

I would like to create a hyperlink via a macro, basically I have two workbooks, when I save and exit one workbook called ‘Workbook A’ I would like that save addressed to then be linked to cell C3 in ‘Workbook B’<?xml:namespace prefix = o ns = "urn:schemas-microsoft-comfficeffice" /><o></o>
<o> </o>
This is my save and exit code<o></o>
<o> </o>
Private Sub CommandButton1_Click()<o></o>
Dim sFile As String<o></o>
ThisFile = Range("B3").Value<o></o>
ActiveWorkbook.SaveAs Filename:="L:XXXX\" & ThisFile<o></o>
Application.Quit<o></o>
End Sub<o></o>
<o> </o>
Can you help?<o></o>

 

[tweedle]

Hello MichaelRSnow;

You can give a swing @ the below function:
[Workbook B is expected to be open in this case.]

Function RecordHyperlinkToExternal(ThisWB$, ThatWB$, ThatWS$, ThatRangeAdd$)
'---------------------------------------------------------------------------------------
' Procedure : RecordHyperlinkToExternal
' Author    : tweedle
' Date      : 2011-08-19
' Citation  : [URL]http://www.mrexcel.com/forum/showthread.php?t=572957[/URL]
' Purpose   : Creates Hyperlinks in Workbooks other than ThisWorkbook
' Usage     :
'---------------------------------------------------------------------------------------
'Application.ScreenUpdating = False
'retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "Book1.xlsx", "Sheet1", "C1")
'Application.ScreenUpdating = True
'Parm1 = ThisWorkbook.Name
'Parm2 = String Name of Target Workbook
'Parm3 = Sheet Name in Target Workbook
'Parm4 = Cell Address in Target Workbook to place Hyperlink
'---------------------------------------------------------------------------------------
'
Application.ScreenUpdating = False
retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "ThisErrors.blah", "Hyperlinks", "C5")
Application.ScreenUpdating = True
   On Error GoTo RecordHyperlinkToExternal_Error
 
    RecordHyperlinkToExternal = False
    Dim newhlink As Hyperlink
    Dim Anch As Object
 
    ThatIsOpen = False
    For Each Window In Application.Windows
        If Window.Caption = ThatWB$ Then
            ThatIsOpen = True
            Window.Activate
        End If
    Next
 
    If ThatIsOpen Then
        Set Anch = Workbooks(ThatWB$).Sheets(ThatWS$).Range(ThatRangeAdd$)
        Set newhlink = Workbooks(ThatWB$).Sheets(ThatWS$).Hyperlinks.Add( _
                       Anch, _
                       Workbooks(ThisWB$).FullName, _
                       TextToDisplay:=ThisWB$)
 
        RecordHyperlinkToExternal = True
    Else
        RecordHyperlinkToExternal = False
        MsgBox "Could not find " & ThatWB$ & " to create Hyperlinks ", vbCritical, "RecordHyperlinkToExternal-Automation Error"
    End If
   On Error GoTo 0
   Exit Function
RecordHyperlinkToExternal_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RecordHyperlinkToExternal of Module Module1"
 
End Function

 

[MichaelRSnow]

Thank you for this, looks complicated, how do I call this function. Never done anything with functions before!

Hello MichaelRSnow;

You can give a swing @ the below function:
[Workbook B is expected to be open in this case.]

Function RecordHyperlinkToExternal(ThisWB$, ThatWB$, ThatWS$, ThatRangeAdd$)
'---------------------------------------------------------------------------------------
' Procedure : RecordHyperlinkToExternal
' Author    : tweedle
' Date      : 2011-08-19
' Citation  : [URL]http://www.mrexcel.com/forum/showthread.php?t=572957[/URL]
' Purpose   : Creates Hyperlinks in Workbooks other than ThisWorkbook
' Usage     :
'---------------------------------------------------------------------------------------
'Application.ScreenUpdating = False
'retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "Book1.xlsx", "Sheet1", "C1")
'Application.ScreenUpdating = True
'Parm1 = ThisWorkbook.Name
'Parm2 = String Name of Target Workbook
'Parm3 = Sheet Name in Target Workbook
'Parm4 = Cell Address in Target Workbook to place Hyperlink
'---------------------------------------------------------------------------------------
'
Application.ScreenUpdating = False
retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "ThisErrors.blah", "Hyperlinks", "C5")
Application.ScreenUpdating = True
   On Error GoTo RecordHyperlinkToExternal_Error
 
    RecordHyperlinkToExternal = False
    Dim newhlink As Hyperlink
    Dim Anch As Object
 
    ThatIsOpen = False
    For Each Window In Application.Windows
        If Window.Caption = ThatWB$ Then
            ThatIsOpen = True
            Window.Activate
        End If
    Next
 
    If ThatIsOpen Then
        Set Anch = Workbooks(ThatWB$).Sheets(ThatWS$).Range(ThatRangeAdd$)
        Set newhlink = Workbooks(ThatWB$).Sheets(ThatWS$).Hyperlinks.Add( _
                       Anch, _
                       Workbooks(ThisWB$).FullName, _
                       TextToDisplay:=ThisWB$)
 
        RecordHyperlinkToExternal = True
    Else
        RecordHyperlinkToExternal = False
        MsgBox "Could not find " & ThatWB$ & " to create Hyperlinks ", vbCritical, "RecordHyperlinkToExternal-Automation Error"
    End If
   On Error GoTo 0
   Exit Function
RecordHyperlinkToExternal_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RecordHyperlinkToExternal of Module Module1"
 
End Function

 

[tweedle]

To call it:
Workbook B is expected to be open.

Application.ScreenUpdating = False
retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "Workbook B.xlsx", "Sheet1", "C4")
Application.ScreenUpdating = True

This bit keeps the screen from any flickering during update

Application.ScreenUpdating = False

This bit actually calls the function:

retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "Workbook B.xlsx", "Sheet1", "C4")

retval is just a variable to which the function returns its result [True/False of success]
--ThisWorkbook.Name is used literally 'as is'
--"Workbook B.xlsx" is the name of your Workbook B
--"Sheet1" is the name of the worksheet on which to put the hyperlink
--"C4" is the address of the cell to put the hyperlink


This turns the screens updates back on [normal]

Application.ScreenUpdating = True

I see I had extranious test lines in the original post-this is clean[er].

Function RecordHyperlinkToExternal(ThisWB$, ThatWB$, ThatWS$, ThatRangeAdd$)
'---------------------------------------------------------------------------------------
' Procedure : RecordHyperlinkToExternal
' Author    : tweedle
' Date      : 2011-08-19
' Citation  : [URL]http://www.mrexcel.com/forum/showthread.php?t=572957[/URL]
' Purpose   : Creates Hyperlinks in Workbooks other than ThisWorkbook
' Usage     :
'---------------------------------------------------------------------------------------
'Application.ScreenUpdating = False
[COLOR=blue]'retval = RecordHyperlinkToExternal(ThisWorkbook.Name, "Book1.xlsx", "Sheet1", "C1")[/COLOR]
'Application.ScreenUpdating = True
'Parm1 = ThisWorkbook.Name
'Parm2 = String Name of Target Workbook
'Parm3 = Sheet Name in Target Workbook
'Parm4 = Cell Address in Target Workbook to place Hyperlink
'---------------------------------------------------------------------------------------
'
   On Error GoTo RecordHyperlinkToExternal_Error
 
    RecordHyperlinkToExternal = False
    Dim newhlink As Hyperlink
    Dim Anch As Object
 
    ThatIsOpen = False
    For Each Window In Application.Windows
        If Window.Caption = ThatWB$ Then
            ThatIsOpen = True
            Window.Activate
        End If
    Next
 
    If ThatIsOpen Then
        Set Anch = Workbooks(ThatWB$).Sheets(ThatWS$).Range(ThatRangeAdd$)
        Set newhlink = Workbooks(ThatWB$).Sheets(ThatWS$).Hyperlinks.Add( _
                       Anch, _
                       Workbooks(ThisWB$).FullName, _
                       TextToDisplay:=ThisWB$)
 
        RecordHyperlinkToExternal = True
    Else
        RecordHyperlinkToExternal = False
        MsgBox "Could not find " & ThatWB$ & " to create Hyperlinks ", vbCritical, "RecordHyperlinkToExternal-Automation Error"
    End If
   On Error GoTo 0
   Exit Function
RecordHyperlinkToExternal_Error:
    MsgBox "Error " & Err.Number & " (" & Err.Description & ") in procedure RecordHyperlinkToExternal of Module Module1"
 
End Function