VBA: Rij kopiëren inclusief hyperlink

[timpio]

Allen,

Via het forum lukt het mij al aardig om het e.e.a. te maken. Ik maak een automatische takenlijst waarbij een voltooide taak moet verhuizen naar het 'voltooide' tabblad. Omgekeerd kan een niet voltooide actie ook weer worden teruggezet naar de lopende actielijst.

Ik heb nog één issue dat ik moet oplossen. Een actie wordt toegevoegd door data in te vullen in een nieuwe rij. Met behulp van gegevensvalidatie zie ik erop toe dat de juiste zaken worden gevuld. Tot slot wil ik in een cel ook een hyperlink kunnen toevoegen. Met mijn onderstaande code wordt een hyperlink niet meegekopieerd als ik de actie op 'voltooid' zet. Iemand een idee?

Is er daarnaast ook een mogelijkheid om net zoals bij gegegvensvalidatie een dropdown te krijgen waarbij gebladerd kan worden door bestanden? Zodat op die manier gelijk het juiste bestand gekoppeld kan worden?

Alvast bedankt.

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
Dim c As Range
For Each c In [I3:Z1500]
If c = "voltooid" Then
c.Rows.EntireRow.Copy
['Voltooid'!A1500].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
c.Rows.EntireRow.Delete
End If
Next
Dim d As Range
For Each d In [I3:Z1500]
If d = "geannuleerd" Then
d.Rows.EntireRow.Copy
['Voltooid'!A1500].End(xlUp).Offset(1, 0).PasteSpecial xlPasteValues
d.Rows.EntireRow.Delete
End If
Next
End Sub

 

[pasan]

heb je het al geprobeerd met alleen Paste ipv PasteSpecial
hier net geprobeerd en hiermee wordt de hyperlink gekopieerd als hyperlink
http://www.youtube.com/watch?v=p_77cZ1Vyl4
en hier een filmpje met hyperlinks in een dropdown

 

[timpio]

Als ik dat doe, loopt het vast op de regel waarin PasteSpecial staat. Dus dat lijkt helaas niet te werken.

 

[pasan]

PasteSpecial xlPasteAll

 

[timpio]

Klinkt logisch, ga het gelijk proberen als ik thuis ben.

 

[timpio]

Hyperlinks worden meegekopieerd! Hartelijk dank.

(klein) Vervolgvraagje: Kun je mbv gegevensvalidatie het ook zo maken, dat je een bestand moet uploaden als je een cel aanklikt? Het zou mooi zijn als je dan een icoontje ziet van bijv. een Word bestand.

 

[pasan]

ik begrijp niet helemaal wat je bedoeld met bestand uploaden!!!!!!
ik denk dat je bedoeld dat je een path naam in de cel wilt hebben als hyperlink klopt dat?

 

[pasan]

met onderstaande code plaats je een hyperlink naar keuze
de code plaats je achter het werkblad
pas de range [A1:A180] aan naar eigen wens

is dit wat je bedoeld?
een icoontje waar jij het over had gaat mij niet lukken

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)

    Dim a As String
    Dim lngCount As Long

 If Not Intersect(Target, [A1:A180]) Is Nothing Then
 
    ' Open file dialog
    With Application.FileDialog(msoFileDialogOpen)
        .AllowMultiSelect = False
        .Show
'Als je op annuleren klikt
On Error Resume Next
        
         lngCount = .SelectedItems.Count
         a = .SelectedItems(lngCount)
         ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=a, TextToDisplay:=a
  
    End With
  End If
End Sub

 

[timpio]

Pasan, het wordt steeds mooier! Werkt uitstekend en is idd wat ik bedoel .

Mijn 'allerlaatste' wens: is het mogelijk dat elke hyperlink nu een standaard naam krijgt, bijvoorbeeld 'link'? Anders wordt het erg lang en mijn kolom is niet zo breed.

Voor de rest werkt het uitstekend.

Thanks !!

 

[snb]

Dit lijkt mij wel voldoende:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  on error resume next   
        
  ActiveSheet.Hyperlinks.Add Selection, Application.GetOpenFilename, , , "Link"
end sub

 

[timpio]

Het werkt, maar dan krijg ik weer een 'popup' om een bestand te selecteren.

Je hebt me wel getriggerd en dit werkt wel:

ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=a, TextToDisplay:="Link"

Als ik nu ook nog een gegevensvalidatie kan meegeven voor die kolom. Oftewel er mag alleen een hyperlink worden ingevoegd met de naam 'Link', dan is mijn doc klaar. Zo werkt het ook hoor

 

[snb]

@Timpio

Lees eens goed: de code die ik plaatste kan de volledige code van bericht #8 vervangen.

 

[timpio]

Ah, dat maakt het eea duidelijk. Maar dan mis ik nog wel het bereik 'Target'?

 

[snb]

Die mag je er van mij best wel aan toevoegen, zodat het toch nog een oneliner blijft.

 

[timpio]

Zal aan mijn bekerkingen liggen, maar het lukt mij niet om dat te combineren. Heb al redelijk wat geprobeerd ;-).

Dus: jouw verkorte versie i.c.m. de range, in mijn geval B3:B1500

 

[snb]

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  on error resume next   
        
  if not intersect(target,Range("B3:B1500")) is nothing then ActiveSheet.Hyperlinks.Add Target, Application.GetOpenFilename, , , "Link"
end sub

 

[timpio]

Super bedankt, werkt perfect.

 

[timpio]

Ook namens collega's bedankt .

Mogelijk nog 'n finetuning. Mijn gehele sheet heeft font-size 9. De tekst 'Link' wordt nu gekopieerd met font-size 11. Ik heb het vermoeden dat de opmaak d.m.v. VBA mee moet komen. Kan ik dit nog toevoegen?

Dus dat: de hyperlink met de tekst 'Link' wordt gekopieerd met font-size 9? MERCI

 

[snb]

Ik dacht het niet: kijk eens bij de opmaak stijlen voor cellen. daar kun je lettergrootte voor hyperlinks instellen.

 

[timpio]

Ik dacht het niet: kijk eens bij de opmaak stijlen voor cellen. daar kun je lettergrootte voor hyperlinks instellen.

Bij voorwaardelijke opmaak (van cellen ed) lukt het niet om het lettertype te veranderen.

Als volgt heb ik het opgelost. Ik heb een macro gemaakt (opgenomen) waarin ik het lettertype van een bepaald bereik wijzig. Dit stuk heb ik vervolgens in jouw code geplakt. Werkt uitstekend.

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
  On Error Resume Next
        
  If Not Intersect(Target, Range("B3:B1500")) Is Nothing Then ActiveSheet.Hyperlinks.Add Selection, Application.GetOpenFilename, , , "Link"

    With Selection.Font
        .Name = "Calibri"
        .Size = 9
    End With
  
End Sub