The language reference describes a typical application of the ChangeLink
method. This article describes another useful application. There is a special kind of workbooks that also generate links – VBA Add-Ins.
You create links in your workbooks if you use user defined function (UDF) of VBA Add-Ins. A cell’s formula shows only the name of your UDF but internally Excel stores the absolute path of the used addin in your workbook (ExcelLink). Excel won’t use the UDFs if you have installed the add-ins but from another location. So, we need to instruct Excel to change the workbooks’ links to an installed add-in that has the same name.
We get the links from the LinkSources
method and change the links as desired.
l = Wb.LinkSources(xlExcelLinks) If Not IsEmpty(l) Then For i = 1 To UBound(l) s = UCase(Right(l(i), Len(l(i)) - InStrRev(l(i), "\"))) If s = UCase(ThisWorkbook.Name) Then Wb.ChangeLink l(i), _ ThisWorkbook.Name, xlExcelLinks Next End If
As you see, we only pass the add-in’s name to the ChangeLink
method. Excel will expand the link with the full path of the add-in.
You can extend the loop with a change of the link to the Analysis ToolPak if desired and assumed that it is installed.
If Val(Application.Version) < 12 Then If s = "ATPVBAEN.XLA" Then Wb.ChangeLink l(i), "ATPVBAEN.xla", _ xlExcelLinks End If
The analysis functions are native worksheet functions in newer Excel versions. So, we change the link only for old versions of Excel.
In the next step, we do some tuning. Excel cannot update links if there is more than one Worksheet selected.
On Error Resume Next Set x = Wb.ActiveSheet If Err.Number <> 0 Then Err.Clear Set x = Wb.Worksheets(1) End If x.Select
We take the ActiveSheet
. If there’s no active sheet we take the first sheet. With x.Select
we ensure that there’s only one sheet selected.
The last step integrates the code to our addin. Add a class module, name it appclass and add the following code.
Private WithEvents App As Application Private Sub App_WorkbookOpen(ByVal Wb As Workbook) Dim l As Variant Dim s As String Dim x As Worksheet Dim i As Long On Error Resume Next Set x = Wb.ActiveSheet If Err.Number <> 0 Then Err.Clear Set x = Wb.Worksheets(1) End If x.Select l = Wb.LinkSources(xlExcelLinks) If Not IsEmpty(l) Then For i = 1 To UBound(l) s = UCase(Right(l(i), Len(l(i)) - InStrRev(l(i), "\"))) If s = UCase(ThisWorkbook.Name) Then Wb.ChangeLink l(i), _ ThisWorkbook.Name, xlExcelLinks If Val(Application.Version) < 12 Then If s = "ATPVBAEN.XLA" Then Wb.ChangeLink l(i), _ "ATPVBAEN.xla", xlExcelLinks End If Next End If End Sub
Switch to the ThisWorkbook
-Section and add the following code.
Private anApp As appclass Private Sub Workbook_Open() Set anApp = New appclass End Sub
This will create our class and establish the event sink for the Applications’ On Workbook Open Event.