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