Hyperlink verdwijnt na kopieren via filter

[Morriss]

Goedemorgen,

ik zit met een probleempje, in het bijgevoegde bestand heb ik een macro gemaakt die een "totaallijst" filtert op codes, door middel van het toekennen van codes aan elke regel wordt de bepaalde regel dus naar het tabblad die bij zijn code hoort gekopieerd.

Het probleem is dat de werknummers een hyperlink (naar een map op de c-schijf) hebben in de totaallijst maar in het andere tabblad opent hij de hyperlink niet, maar geeft ie de volgende foutmelding:
"Het adres van deze site is niet geldig. Controleer het adres en probeer opnieuw".

Als ik de hyperlink gewoon met ctrl+c, ctrl+v kopieer, dan kan ik de hyperlink wel gewoon gebruiken, ook op een ander tabblad.

Er moet dus of iets aangepast worden in de macro (geen idee wat).
Of er moet nadat de macro zijn ding heeft gedaan nog iets gebeuren waardoor de hyperlinks ook gekopieerd worden, ik heb al een beetje zitten spelen met vertikaal zoeken, maar ik kom er niet uit.

Bijlage:
Bekijk bijlage Projectgegevens (censored).zip


Alvast bedankt voor de moeite!

met vriendelijke groet

 

[oeldere]

deze code wordt nu gebruikt op de gegevens op een ander tabblad te zetten.

Sub Opdrachten()
'
' Opdrachten Macro
' Met deze macro wordt het tabblad "Opdrachten" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
    ActiveSheet.Unprotect
    Sheets("TOTAALLIJST").Range("B4:Q1250").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=Range("U4:U5"), CopyToRange:=(Range("B4:Q4")), Unique:=False
    ActiveWindow.ScrollColumn = 15
    ActiveWindow.ScrollColumn = 14
    ActiveWindow.ScrollColumn = 13
    ActiveWindow.ScrollColumn = 12
    ActiveWindow.ScrollColumn = 11
    ActiveWindow.ScrollColumn = 10
    ActiveWindow.ScrollColumn = 9
    ActiveWindow.ScrollColumn = 8
    ActiveWindow.ScrollColumn = 7
    ActiveWindow.ScrollColumn = 6
    ActiveWindow.ScrollColumn = 5
    ActiveWindow.ScrollColumn = 4
    ActiveWindow.SmallScroll ToRight:=2
    Columns("J:J").ColumnWidth = 8.43
    Columns("J:J").ColumnWidth = 9.86
    Columns("J:J").ColumnWidth = 10.57
    ActiveWindow.SmallScroll ToRight:=4
    Columns("L:L").ColumnWidth = 7.57
    Columns("L:L").ColumnWidth = 11.43
    ActiveWindow.SmallScroll ToRight:=-6
    ActiveWindow.SmallScroll Down:=-21
    ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

de opmaak van de hyperlink in je totaallijst dient meegekopieert te worden.

ik ben geen VBA kenner, maar met deze gegevens krijg je misschien nieuwe reacties.

 

[Warme bakkertje]

Pas het pad aan bij mypath

Sub Opdrachten()
'
' Opdrachten Macro
' Met deze macro wordt het tabblad "Opdrachten" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
    With Sheets("Opdrachten")
        .Unprotect
        Sheets("TOTAALLIJST").Range("B4:Q1250").AdvancedFilter Action:=xlFilterCopy, _
        CriteriaRange:=.Range("U4:U5"), CopyToRange:=.Range("B4:Q4"), Unique:=False
        .Columns("J:J").ColumnWidth = 10.57
        .Columns("L:L").ColumnWidth = 11.43
        For Each cl In .Range("B5:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
            mypath = "D:\Mijn documenten\Test\"
            myfile = cl.Value
            cl.Formula = "=HYPERLINK(""" & mypath & myfile & """,""" & cl.Value & """)"
        Next
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
    End With
End Sub

 

[Morriss]

Heb het even druk gehad, maar nu weer tijd om het verder uit te zoeken, vandaar de late reactie.

Bij elk werknummer staat een andere hyperlink, dus als ik bij de macro maar 1 pad in kan vullen kom ik er niet denk ik (of begrijp ik dat verkeerd?)

Buiten dat werkt het nog steeds niet bij mij, hij ziet nu inderdaad wel dat er een hyperlink aan gekoppeld zit, maar ik krijg nu de foutmelding: "Het opgegeven bestand kan niet worden geopend" als ik op de hyperlink klik op het tabblad "opdrachten".

Zie bijlageBekijk bijlage Projectgegevens (censored).zip

Alvast bedankt voor de moeite

Met vriendelijke groet,

 

[Warme bakkertje]

De volledige naam is dan \\brddch03\data\bouw-vr781004.xlsx veronderstel ik

mypath = "\\brddch03\data\bouw-vr"
myfile = cl.Value & ".xlsx"

of is bouw-vr ook een directory, anders moet er nog een \ achter bij mypath

 

[Morriss]

Dat is ook een directory inderdaad, ik wil gewoon een map openen via de snelkoppeling, ik ga weer proberen...

Bij myfile moet dan ook iets aangepast worden neem ik aan? aangezien daar nu .xlsx staat, maar de snelkoppeling is niet naar een excelbestand maar naar een map met bestanden en submappen.

bouw-vr zou dus bijvoorbeeld net zo goed de C-schijf kunnen zijn, ik heb het aangepast zoals hierboven met het de slash \ erbij, maar er veranderd niks zover ik kan zien, nog steeds dezelfde foutmelding.

 

[Warme bakkertje]

Dus die getallen horen ook bij de Mapnaam ?
Geef dan eens het volledige pad naar een directory die geopend moet worden.
Ik was in de veronderstelling dat de getallen bestandsnamen waren en geen mapnamen

 

[Morriss]

Ik snap niet zo goed waar jij/u die getallen vind, maar dat zijn ook nog mappen inderdaad.

Dit is een voorbeeld van een volledig pad:

\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\781282

Nog even voor de duidelijkheid: er hoeven geen bestanden geopend te worden oid. Alleen de map (in dit geval) "781282".

Bedankt voor de moeite

MVG

 

[Warme bakkertje]

Ik moet al wel een bril dragen om te kunnen lezen, maar zelfs zonder bril zie ik in kolom A toch getallen staan

mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value
cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"

 

[Morriss]

ow zo haha ik dacht dat jij ergens in de eigenschappen van een hyperlink zat te kijken ofzo, terwijl ik die niet kon vinden, dus vandaar dat ik het me afvroeg ik ga het even uitproberen, thnx!

 

[Morriss]

Ik krijg nog steeds dezelfde foutmelding.

Wat doe ik nog verkeerd?

Dit is nu het bestand:
Bekijk bijlage Projectgegevens (censored).zip

Dit is nu de opzet van mijn MACRO:

Sub Opdrachten()
'
' Opdrachten Macro
' Met deze macro wordt het tabblad "Opdrachten" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
With Sheets("Opdrachten")
.Unprotect
Sheets("TOTAALLIJST").Range("B4:Q1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=.Range("U4:U5"), CopyToRange:=.Range("B4:Q4"), Unique:=False
.Columns("J:J").ColumnWidth = 10.57
.Columns("L:L").ColumnWidth = 11.43
For Each cl In .Range("B5:B" & .Cells(Rows.Count, 2).End(xlUp).Row)
mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value
cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"
Next
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End With
End Sub

 

[Warme bakkertje]

Dan moet er toch een fout zitten in je pad naar de map, want ik heb 'm hier even aangepast naar een map op mijn schijf en die wordt perfect geopend.

 

[Morriss]

Ik probeer even het pad te veranderen naar een map die niet op het netwerk zit... kijken of het dan werkt

 

[Morriss]

Nou, het werkt echt niet hier, ook niet als ik gewoon naar bureaublad verwijs of naar de C-schijf, zou je het bestandje naar mij willen sturen wat jij gebruikt?

Ik hoef toch als ik het pad wil wijzigen alleen maar (hieronder) in de bovenste regel tussen de aanhalingstekens het pad te veranderen?

mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value
cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"

 

[Warme bakkertje]

Ik heb bij wijze van test op Tabblad Totaallijst in kolom A Test ingevuld (bestaande map)
Dan op tabblad Opdrachten de Update uitgevoerd en dan komt in kolom A de hyperlink Test te staan.

mypath= "D:\Mijn documenten\" & cl.value

De hyperlink verwijst dan naar D:\Mijn documenten\Test en klaar is kees.

 

[Morriss]

Hmmm, heb nu exact gedaan wat jij zegt, NU WERKT IE!

Nou nog kijken of ik het overal op toegepast krijg, 1 van de fouten die ik denk ik maakte was dat ik bij mypath 1 map te ver ging, dus net zover als de hyperlink, ik vroeg me al af hoe dat ging werken voor die honderden verschillende mappen

Hardstikke bedankt, ik hoop er verder uit te komen zo, zo niet, dan hoor je het. BEDANKT HE!

MVG

 

[Morriss]

ok

 

[Morriss]

Een aantal van de MACRO'S ziet er uit als hier onder, waar moet ik de regels met betrekking tot de hyperlink zetten om het te laten werken? ik kom er niet aan uit.



Sub Offertes()
'
' Offertes Macro
' Met deze macro wordt het tabblad "Offertes" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
ActiveSheet.Unprotect
Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("U4:U5"), CopyToRange:=Range("B4:O4"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub

 

[Warme bakkertje]

Nu volg ik even niet
Je hebt toch je Opdrachten-macro om te vergelijken ?

 

[Morriss]

Uhm, dat is voor 1 tabblad. Het komt er op neer dat ik 4 van zulke tabbladen heb: opdrachten, opdrachten archief, offertes, en offertes uitstaand. Ik krijg hem alleen werkend voor het tabblad Opdrachten waar jij dus mee geholpen hebt.

Dit is de volledige MACRO:

Sub Opdrachten()
'
' Opdrachten Macro
' Met deze macro wordt het tabblad "Opdrachten" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
ActiveSheet.Unprotect
Sheets("TOTAALLIJST").Range("B4:Q1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("U4:U5"), CopyToRange:=Range("B4:Q4"), Unique:=False
ActiveWindow.ScrollColumn = 15
ActiveWindow.ScrollColumn = 14
ActiveWindow.ScrollColumn = 13
ActiveWindow.ScrollColumn = 12
ActiveWindow.ScrollColumn = 11
ActiveWindow.ScrollColumn = 10
ActiveWindow.ScrollColumn = 9
ActiveWindow.ScrollColumn = 8
ActiveWindow.ScrollColumn = 7
ActiveWindow.ScrollColumn = 6
ActiveWindow.ScrollColumn = 5
ActiveWindow.ScrollColumn = 4
ActiveWindow.SmallScroll ToRight:=2
Columns("J:J").ColumnWidth = 8.43
Columns("J:J").ColumnWidth = 9.86
Columns("J:J").ColumnWidth = 10.57
ActiveWindow.SmallScroll ToRight:=4
Columns("L:L").ColumnWidth = 7.57
Columns("L:L").ColumnWidth = 11.43
ActiveWindow.SmallScroll ToRight:=-6
ActiveWindow.SmallScroll Down:=-21
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub ArchiefOpdrachten()
'
' ArchiefOpdrachten Macro
' Met deze macro wordt het tabblad "Archief Opdrachten" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
ActiveSheet.Unprotect
Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("U4:U5"), CopyToRange:=Range("B4:O4"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub Offertes()
'
' Offertes Macro
' Met deze macro wordt het tabblad "Offertes" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
ActiveSheet.Unprotect
Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("U4:U5"), CopyToRange:=Range("B4:O4"), Unique:=False
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub
Sub ArchiefOffertes()
'
' ArchiefOffertes Macro
' Met deze macro wordt het tabblad "Archief Offertes" up to date gebracht met betrekking tot de invoering van de codes in de TOTAALLIJST. Vervolgens worden alle kolommen die niet van toepassing zijn leeggemaakt.
'

'
ActiveWindow.SmallScroll Down:=-33
ActiveSheet.Unprotect
Sheets("TOTAALLIJST").Range("B4:M1250").AdvancedFilter Action:=xlFilterCopy, _
CriteriaRange:=Range("U4:U5"), CopyToRange:=Range("B4:M4"), Unique:=False
ActiveWindow.SmallScroll Down:=-18
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
End Sub