Связь пользовательской функции при смене пользователя

Private Sub Workbook_Open()
    'проверим битые ссылки ВПР2
     With ActiveWorkbook
         iExcelLinks = .LinkSources(xlExcelLinks)
        If IsArray(iExcelLinks) = True Then
            iUserName = Environ("UserName")
            For iCount& = 1 To UBound(iExcelLinks)
                iLink = iExcelLinks(iCount&)
                If .LinkInfo(iLink, xlLinkInfoStatus) = xlLinkStatusMissingFile And _
                   InStr(1, iLink, "ВПР2", vbTextCompare) > 0 Then
                    NewLink = "C:\Users\" & iUserName & "\AppData\Roaming\Microsoft\AddIns\ВПР2.xla"
                    .ChangeLink Name:=iLink, NewName:=NewLink, Type:=xlExcelLinks
                    .UpdateLink Name:=.LinkSources
                End If
            Next
        End If
    End With

Private Sub Workbook_Open()
Set anApp = New appclass
End Sub

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
  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 = "ВПР2.XLA" Then Wb.ChangeLink l(i), _
          "ВПР2.xla", xlExcelLinks
      End If
    Next
  End If

Private WithEvents App As Application

Private Sub Workbook_Open()
Set App = Application