Koppelingen naar UDFs in Addins herstellen

Het zojuist geopende bestand aanpassen

Zodra de invoegtoepassing detecteert dat de gebruiker een bestand opent moet actie ondernomen worden.

Allereerst checken we alle koppelingen in het bestand om te zien of er één bij is die bij onze invoegtoepassing hoort. Daarna checken we voor de zekerheid ook alle formules of deze onze UDF(s) gebruiken en werken deze desnoods apart bij.

De code hieronder staat in een "normale" module genaamd modProcessWBOpen:

Sub ProcessNewBookOpened(oBk As Workbook)
'-------------------------------------------------------------------------
' Procedure : ProcessNewBookOpened
' Company   : JKP Application Development Services (c) 2005
' Author    : Jan Karel Pieterse
' Created   : 2-6-2008
' Purpose   : Deze routine wordt gestart zodra een bestand geopend wordt.
' Aangeroepen vanuit: clsAppEvents.App_Workbook_Open en ThisWorkbook.Workbook_Open
'-------------------------------------------------------------------------
    'Soms is OBk gelijk aan nothing, dan niets doen.
    If oBk Is Nothing Then Exit Sub
    If oBk Is ThisWorkbook Then Exit Sub
    If oBk.IsInplace Then Exit Sub
    CheckAndFixLinks oBk
    ReplaceMyFunctions oBk
    CountBooks
End Sub

Sub CheckAndFixLinks(oBook As Workbook)
'-------------------------------------------------------------------------
' Procedure : CheckAndFixLinks Created by Jan Karel Pieterse
' Company   : JKP Application Development Services (c) 2008
' Author    : Jan Karel Pieterse
' Created   : 2-6-2008
' Purpose   : Checkt koppelingen naar deze invoegtoepassing
'             en fixt deze als ze niet juist zijn
'-------------------------------------------------------------------------
    Dim vLink As Variant
    Dim vLinks As Variant
    'Alle koppelingen ophalen
    vLinks = oBook.LinkSources(xlExcelLinks)
    'Als we geen koppelingen hebben, dan eindigen
    If IsEmpty(vLinks) Then Exit Sub
    For Each vLink In vLinks
        If vLink Like "*" & ThisWorkbook.Name Then
            'Een koppeling gevonden naar onze invoegtoepassing, omleggen
            'naar de huidige lokatie
            Application.DisplayAlerts = False
            oBook.ChangeLink vLink, ThisWorkbook.FullName, xlLinkTypeExcelLinks
            Application.DisplayAlerts = True
        End If
    Next
    On Error GoTo 0
End Sub

Private Sub ReplaceMyFunctions(oBk As Workbook)
'-------------------------------------------------------------------------
' Procedure : ReplaceMyFunctions Created by Jan Karel Pieterse
' Company   : JKP Application Development Services (c) 2008
' Author    : Jan Karel Pieterse
' Created   : 2-6-2008
' Purpose   : Zorgt dat alle functies naar deze invoegtoepassing wijzen
'-------------------------------------------------------------------------
    Dim oSh As Worksheet
    Dim oFirstFound As Range
    Dim oFound As Range

    On Error Resume Next
    'Zoek door alle werkbladen naar de UDF "UDFDemo("
    For Each oSh In oBk.Worksheets
        Set oFirstFound = _
        oSh.UsedRange.Cells.Find(what:="UDFDemo(", after:=oSh.UsedRange.Cells(1, 1), _
                                 LookIn:=xlFormulas, LookAt:=xlPart, _
                                 SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False)
        If Not oFirstFound Is Nothing Then
            'Gevonden, pas formule aan met juiste pad
            'We nemen even aan dat de functie NIET genest is!!!
            oFirstFound.Formula = "='" & ThisWorkbook.FullName & "'!" & _
                                  Right(oFirstFound.Formula, _
                                        Len(oFirstFound.Formula) - _
                                        InStr(oFirstFound.Formula, "My(") + 1)
            Set oFound = oFirstFound
            Do
                Set oFound = _
                oSh.UsedRange.Cells.Find(what:="UDFDemo(", after:=oFound, LookIn:=xlFormulas, _
                                         LookAt:=xlPart, SearchOrder:=xlByRows, _
                                         SearchDirection:=xlNext, MatchCase:=False)
                If Not oFound Is Nothing Then
                    'We nemen even aan dat de functie NIET genest is!!!
                    oFound.Formula = "='" & ThisWorkbook.FullName & "'!" & _
                                     Right(oFound.Formula, Len(oFound.Formula) - _
                                                           InStr(oFound.Formula, "My(") + 1)
                End If
            Loop Until oFound Is Nothing Or oFound.Address = oFirstFound.Address
        End If
    Next
End Sub

Lees het commentaar in de code om uit te vinden wat hier gebeurt.

Nou, dat zou het dan moeten zijn zou je denken. Niet helemaal. Soms wanneer je een bestand opent vauit verkenner, dan heeft Excel dat bestand al open voordat je invoegtoepassing is geladen en geinitialiseerd. De koppelingen van dat bestand worden dan dus niet bijgewerkt.

Volgende pagina: Werkmappen die geopend worden vanuit verkenner aanpassen.

Vragen, suggesties en opmerkingen

Heeft u vragen, suggesties of opmerkingen? Gebruik dan dit formulier.

Mocht uw vraag niet direct relevant zijn voor deze pagina, maar een algemene Excel vraag betreffen, dan adviseer ik om deze hier te stellen: www.eileenslounge.com.