• 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.

Hyperlink aanpassen met VBA

Status
Niet open voor verdere reacties.
Waarom plaats je niet gewoon het document waar je dat in test?
 
Beste,

In bijlage het bestandje met de codes erin.
 

Bijlagen

  • Controle steigers.xlsm
    16,4 KB · Weergaven: 23
Dat maakt het duidelijker. Een Hyperlink aanpassen gaat kennelijk niet zomaar, omdat Excel zich er zelf ook nog weer tegenaan bemoeid.
Deze verwijderd de hyperlink en voegt een nieuwe toe met de juiste gegevens:
Probeer het eens:
Code:
Sub hyperlink5()
    Dim hl As Hyperlink
    For Each hl In Columns(1).Hyperlinks
        If Left(hl.Address, 11) = "javascript:" Then
            HLadres = Mid(hl.Address, 30, Len(hl.Address) - 41)
            HLsubadres = Split(hl.SubAddress, "'")(0)
            HLcel = hl.Range.Address
            HLtekst = hl.TextToDisplay
            
            hl.Delete
            
            With ActiveSheet
                .Hyperlinks.Add anchor:=.Range(HLcel), _
                Address:=HLadres & HLsubadres, _
                TextToDisplay:=HLtekst
            End With
        End If
    Next
End Sub
 
Laatst bewerkt:
zonder de code van edmoor in twijfel te trekken ,zijn vba kennis is het (grooooote) veelvoud van de mijne, zou ik het zo doen.

in de kolom H een voorbeeld hoe de link er na de bewerking uitziet
 
Laatst bewerkt:
ik krijg volgend bericht, maar toch weeral een bewijs dat uw kennis veel groter is
 

Bijlagen

  • 2019-08-19.png
    2019-08-19.png
    154,9 KB · Weergaven: 49
Het ziet er in ieder geval goed uit, dus ik ben benieuwd wat je hebt gedaan :)
Ik doe nooit wat met hyperlinks dus voor mij was het ook uitzoeken.
 
Ik had gewoon de knop uit het vorige voorbeeld gekopieerd maar vergeten de code ook te kopiëren. Het zou nu beter moeten zijn.(hoop ik)
 

Bijlagen

  • Controle steigers (1).xlsm
    20,4 KB · Weergaven: 25
Ziet er goed uit.
Kennelijk zit 'm het verschil in het leeg maken van het subadres, wat ik niet deed.
Nu afwachten wat TS zegt :)
 
Beste edmoor en emields,

Bijna, kan bij beide de server niet vinden.

edmoor.PNG

emields.PNG

@edmoor,
Bij jou krijg ik het volgende:

Code:
http://wfasbprod.sidmar/stelling/a9672eda-44e8-48c0-a2f7-185db4b86ed3

ontbreekt:

Code:
http://wfasbprod.sidmar[COLOR="#FF0000"].be/asb.web/#[/COLOR]/stelling/a9672eda-44e8-48c0-a2f7-185db4b86ed3

@emields,
Bij jou krijg ik het volgende:

Code:
http://wfasbprod.sidmar.be/asb.web/stelling/a9672eda-44e8-48c0-a2f7-185db4b86ed3

ontbreekt:

Code:
http://wfasbprod.sidmar.be/asb.web/[COLOR="#FF0000"]#/[/COLOR]stelling/a9672eda-44e8-48c0-a2f7-185db4b86ed3
 
Beste,

Heb de code van emields aangepast en nu zou het moeten gaan

Code:
Sub Knop3_Klikken()
 Dim hl As Hyperlink
    For Each hl In Columns(1).Hyperlinks
        If Left(hl.Address, 11) = "javascript:" Then
            x = Mid(hl.Address, 30)
            y = Mid(hl.SubAddress, 2, Len(hl.SubAddress) - 13)
            hl.SubAddress = ""
           hl.Address = x & [COLOR="#FF0000"]"#/" &[/COLOR] y
        End If
    Next
End Sub
 
Ok. Zo dan:
Code:
Sub hyperlink5()
    Dim hl As Hyperlink
    For Each hl In Columns(1).Hyperlinks
        If Left(hl.Address, 11) = "javascript:" Then
            HLadres = Mid(hl.Address, 30, Len(hl.Address))
            HLsubadres = Split(hl.SubAddress, "'")(0)
            HLcel = hl.Range.Address
            HLtekst = hl.TextToDisplay
            
            hl.Delete
            
            With ActiveSheet
                .Hyperlinks.Add anchor:=.Range(HLcel), _
                Address:=Replace(HLadres & HLsubadres, "//", "/"), _
                TextToDisplay:=HLtekst
            End With
        End If
    Next
End Sub
 
Beste edmoor,

ontbreekt nog steeds:

Code:
.be/asb.web/#
 
Dit is wat er in je bestand staat:
HL.JPG

En dit is het resultaat van de sub:
http:/wfasbprod.sidmar.be/asb.web/stelling/a9672eda-44e8-48c0-a2f7-185db4b86ed3

Dat lijkt me compleet.
En dat # zie ik dus nergens.
 
Laatst bewerkt:
Beste edmoor,

# is reeds vermeld in #5, #14, #16, #30, #31

Deze code werkt nu perfect bij mij, misschien kan jij die van jou aanpassen naar onderstaand voorbeeld.

Code:
Sub Knop3_Klikken()
 Dim hl As Hyperlink
    For Each hl In Columns(1).Hyperlinks
        If Left(hl.Address, 11) = "javascript:" Then
            x = Mid(hl.Address, 30)
            y = Mid(hl.SubAddress, 2, Len(hl.SubAddress) - 13)
            hl.SubAddress = ""
           hl.Address = x & "#/" & y
        End If
    Next
End Sub
 
Als die het goed doet kan je die toch gewoon gebruiken?
 
Beste edmoor,

ik wou je niet aan de kant schuiven en had je misschien ook nog iets in petto
Anders sluit ik deze af
Nogmaals dank aan emields, edmoor en HSV.
 
Zo voel ik dat niet hoor.
Je moet gebruiken wat het beste voor je werkt :)
 
Status
Niet open voor verdere reacties.
Steun Ons

Nieuwste berichten

Terug
Bovenaan Onderaan