Hyperlink verdwijnt na kopieren via filter

Warme bakkertje · 23 mrt 2011

Test deze eens. Kijk overal nog wel het pad na.

Code:

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

'
With Sheets("Archief Opdrachten")
    .Unprotect
    Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("U4:U5"), CopyToRange:=.Range("B4:O4"), Unique:=False
    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
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.
'

'
With Sheets("Offertes")
    .Unprotect
    Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("U4:U5"), CopyToRange:=.Range("B4:O4"), Unique:=False
    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
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.
'

'
With Sheets("Archief Offertes")
    .Unprotect
    Sheets("TOTAALLIJST").Range("B4:O1250").AdvancedFilter Action:=xlFilterCopy, _
    CriteriaRange:=Range("U4:U5"), CopyToRange:=.Range("B4:M4"), Unique:=False
    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

Morriss · 23 mrt 2011

Dit lijkt allemaal goed te werken. BEDANKT!

Er zit voor mij nog een minpuntje aan: bij de originele hyperlink maakt het niet uit of de map waar de hyperlink naar verwijst dezelfde naam heeft als de tekst waar je op drukt als hyperlink zijnde. Maar bij de gekopieerde hyperlink moet de map precies dezelfde naam hebben, anders krijg ik dus een foutmelding.

Is dit nog te verhelpen of is dat niet te doen?

MVG

Morriss · 23 mrt 2011

Nog een vraag:

op sommige tabbladen komen hyperlinks te staan na het kopieren die naar verschillende mappen verwijzen, daarmee bedoel ik dat de ene hyperlink bijvoorbeeld een snelkoppeling is naar "map A" en de andere hyperlink naar "map B".

"Map A" staat dan in een andere map dan "map B".

ofterwijl: kan ik meerdere paden toevoegen, zodat ie bijvoorbeeld zelf zoekt waar die "map A" te vinden is? Of een andere oplossing die bovenstaande mogelijk maakt?

THNX!

Morriss · 28 mrt 2011

Hmmm Niemand?

oeldere · 28 mrt 2011

Code:

"Map A" staat dan in een andere map dan "map B".

weet je zelf wel in welke map deze staan.

dan zet je deze map als tekst in een cel.

b.v.
a3 = C:\testmap\reeksbestandenA\

vervolgens kun je deze gegevens samenvoegen tot hyperlink.

Morriss · 28 mrt 2011

Uhm, ik begrijp niet helemaal wat je bedoeld, maar het gaat over honderden hyperlinks, bedoel je nu dat ik per hyperlink aan moet geven naar welke map de hyperlink verwijst?

MVG

oeldere · 28 mrt 2011

met de oplossing van warm bakkertje ben je niet verder gekomen?

je zult excel (volgens mij, als niet VBA-kenner) toch moeten aangeven in welke map iets is terug te vinden.

Hoe doe je dat nu dan?

Morriss · 28 mrt 2011

Met de oplossing van warm bakkertje ben ik een heel eind verder gekomen, maar nog niet waar ik wil zijn zeg maar.

In de Macro geef ik nu de map aan waar excel naar de hyperlink moet zoeken, mijn vraag is of ie ook in 2 mappen kan zoeken.

In de macro is dat de onderstreepte vetgedrukte regel:

Code:

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)
          [U][B]  mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value[/B][/U]            
        cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"
        Next
        .Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        ActiveWindow.SmallScroll Down:=-600
    End With
End Sub

Morriss · 31 mrt 2011

Iemand een idee?

Morriss · 5 apr 2011

Niemand?

Morriss · 21 apr 2011

Nog steeds niemand?

Warme bakkertje · 21 apr 2011

Ik zou eerst uittesten in welke dir het bestand zich bevindt en dan mypath overeenkomstig bepalen

Code:

 If Dir(ThisWorkbook.Path & "\" & "helpmij.xls") = "" Then
        mypath = "D:\Mijn documenten\Test1\helpmij.xls"
    Else
        mypath = ThisWorkbook.Path & "\" & "helpmij.xls"
    End If
    MsgBox mypath 'deze mag je verwijderen na de test

Morriss · 28 apr 2011

Waar moet ik die regels van jou invullen om te testen warme bakkertje? (zie vba hieronder)

If Dir(ThisWorkbook.Path & "\" & "helpmij.xls") = "" Then
En wat moet ik in bovenstaande zin invullen? Ik zie helpmij.xls staan, maar de snelkoppeling moet naar een map toe zijn, of begrijp ik het nou niet goed?

Code:

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
ActiveWindow.SmallScroll Down:=-600
End With
End Sub

Warme bakkertje · 29 apr 2011

Code:

Sub tst()
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)
If Dir("\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value) = "" Then
    mypath = "[COLOR="red"]Zet hier het pad naar de 2de directory waar je wil zoeken[/COLOR]"
Else
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\" & cl.Value
End If
cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"
Next
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.SmallScroll Down:=-600
End With
End Sub

Morriss · 29 apr 2011

Op de een of andere manier pakt ie elke keer alleen de laatste hyperlink in de rij.
Er zit dus om de een of andere reden een volgorde in het "if" "then" "else" verhaal.

Ook pakt ie elke keer alleen het eerste path wat ik opgeef, dus als ik CALC en OPDR omdraai (in de vba) dan pakt ie alleen CALC, zo pakt ie alleen OPDR

Mijn vba is nu:

Code:

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)
If Dir("\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value) = "" Then
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value
Else
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\CALC\" & cl.Value
End If
cl.Formula = "=HYPERLINK(""" & mypath & """,""" & cl.Value & """)"
Next
.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWindow.SmallScroll Down:=-600
End With
End Sub

Warme bakkertje · 29 apr 2011

Code:

If Dir("\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value) = "" Then
mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\CALC\" & cl.Value
Else
mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value
End If

Eerst wordt gekeken in map OPDR of het bestand daar aanwezig is, zoneen wordt het pad gezet naar CALC. In het andere geval wordt het pad gezet naar OPDR.

Morriss · 29 apr 2011

Ik heb nog even wat testjes gedaan. Het lijkt toch echt om de volgorde te gaan

ik heb 4 mappen gemaakt en 4 hyperlinks naar die mappen.
map 1 = calc
map 2 = opdr
map 3 = calc
map 4 = opdr

Als ik de vba zo instel:

Code:

If Dir("\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value) = "" Then
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\CALC\" & cl.Value
Else
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value

en ik zet de nummers in het excel-bestand in deze volgorde:

1, 2, 3, 4, dan geven allen een foutmelding (opgegeven bestand kan niet worden geopend).
1, 2, 4, 3, dan geven 1, 2 en 4 een foutmelding en 3 werkt dan goed.
2, 3, 4, 1, dan geven 2, 3 en 4 een foutmelding en 1 werkt dan goed.

Dus altijd als de laatste hyperlink een CALC hyperlink is werkt ie en anders niet, alle voorgaande hyperlinks werken niet.

Als ik de vba omdraai, dus:

Code:

If Dir("\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\CALC\" & cl.Value) = "" Then
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\OPDR\" & cl.Value
Else
    mypath = "\\brddch03\data\bouw-vr\KLANT OP KLANTNUMMERS\TEST\CALC\" & cl.Value

dan is het omgekeerde waar,

alleen als de laatste hyperlink (qua volgorde) een OPDR hyperlink is werkt ie, anders niet.

Geen flauw idee wat ik hier moet veranderen om het werkend te krijgen.

bedankt voor alle moeite iig

Warme bakkertje · 29 apr 2011

Ik heb ook wat testen gedaan, en als ik jouw situatie simuleer werkt dit zonder problemen voor mij.
Misschien is dit netwerk-gerelateerd, maar voor mij werkt dit iig perfect.

huijb · 29 apr 2011

@Morriss
Wanneer je een VBA-code of formule wil toevoegen, plaats deze dan tussen de code-tags (

Code:

en

) oftewel selecteer je code en klik op het # icoontje. Bij voorbaat dank, zeker ook namens de helpers.

Morriss · 2 mei 2011

Ja, ik zag al dat dat gangbaar was, wist alleen nog niet hoe. Ik zal het doen in het vervolg!

Hyperlink verdwijnt na kopieren via filter

Meubilair

Gebruiker

Gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Terugkerende gebruiker

Gebruiker

Gebruiker

Gebruiker

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Meubilair

Gebruiker

Meubilair

Supermoderator

Gebruiker

Wij waarderen jouw privacy