• Privacywetgeving
    Het is bij Helpmij.nl niet toegestaan om persoonsgegevens in een voorbeeld te plaatsen. Alle voorbeelden die persoonsgegevens bevatten zullen zonder opgaaf van reden verwijderd worden. In de vraag zal specifiek vermeld moeten worden dat het om fictieve namen gaat.

VBA-code om link te maken

Senso

Inventaris
Lid geworden
13 jun 2016
Berichten
12.151
Besturingssysteem
W11 Pro 25H2
Office versie
Office 2007 H&S en Office 2021 Prof Plus
Waar zit de fout en wat moet het zijn? Maak een link naar de belastingsite en open de link met Chrome. Excel 2007.

PHP:
Sub VervangRSINDoorChromeLink()
    Dim ws As Worksheet
    Dim rSectie As Range
    Dim EersteCel As String
    Dim ZoekTekst As String
    Dim LinkAdres As String
    Dim FormuleTekst As String
    Dim ChromePad As String

    ' --- CONFIGURATIE ---
    ZoekTekst = "RSIN"
    ' Pas hier de URL aan waarnaar verwezen moet worden:
    LinkAdres = "https://www.belastingdienst.nl/wps/wcm/connect/nl/aftrek-en-kortingen/content/anbi-status-controleren"
    
    ' Het standaard installatiepad van Google Chrome
    ChromePad = "C:\Program Files (x86)\Google\Chrome\Application\chrome.exe"
    ' ---------------------

    ' Bouw de Excel HYPERLINK formule die Chrome aanroept via een cmd-opdracht
    ' Structuur: =HYPERLINK("cmd.exe /c start chrome.exe [URL]", "[Weergavetekst]")
    FormuleTekst = "=HYPERLINK(""cmd.exe /c start """"Chrome"""" """ & ChromePad & """ """ & LinkAdres & """", """ & ZoekTekst & """)"

    ' Loop door alle werkbladen in het huidige bestand
    For Each ws In ThisWorkbook.Worksheets
        ' Zoek naar de eerste cel met de tekst "RSIN" (exacte match of onderdeel van)
        Set rSectie = ws.Cells.Find(What:=ZoekTekst, LookIn:=xlValues, LookAt:=xlPart, MatchCase:=False)
        
        If Not rSectie Is Nothing Then
            EersteCel = rSectie.Address
            
            ' Vervang de tekst door de formule zolang er resultaten worden gevonden
            Do
                ' Voorkom dat cellen die al een formule hebben opnieuw overschreven worden
                If Not rSectie.HasFormula Then
                    rSectie.Formula = FormuleTekst
                End If
                
                ' Zoek naar de volgende cel
                Set rSectie = ws.Cells.FindNext(rSectie)
                
                ' Stop als de zoekfunctie vastloopt of weer bij de eerste cel uitkomt
                If rSectie Is Nothing Then Exit Do
            Loop While rSectie.Address <> EersteCel
        End If
    Next ws

    MsgBox "Klaar! Alle vermeldingen van '" & ZoekTekst & "' zijn omgezet naar een Chrome-link.", vbInformation, "Voltooid"
End Sub
 
Terug
Bovenaan Onderaan