Link Aktifleştirme

[jraujr]

Merhaba arkadaşlar metin belgesinden kopyaladığım link exel içinde pasif kalıyor tıklanmıyor, ancak mouse ile açıp enterla tıkladığımda link aktif olup tıklanabilir oluyor.
Böyle 1000 satırım var tek tek yapmak uğraştırır.
Toplu olarak bu hücrelere sen linksin aktif ol! nasıl deriz?

 

[muratboz06]

Aşağıdaki kodu kullanarak yapabilirsiniz. C1:C1000 aralığını linklerin yer aldığı sütun-satır aralığına göre değiştirirsiniz.

Sub HyperlinkConverter()
   Dim xCell As Range
   For Each xCell In Range("C1:C1000")
      If xCell.Value <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
      End If
   Next xCell
End Sub

 

[cicosz]

Merhaba,

@muratboz06 'nın gönderisine ek olarak aşağıdaki durumları da değerlendirebilirsiniz.

Verilerin A sütununda olduğunu varsayarsak;
Formülle

=KÖPRÜ(A1)

Worksheet_Change ile

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A" & Sheets("veri").Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Dim aralik As Range
Dim hucre As Range

Set aralik = ThisWorkbook.Sheets("veri").Range("A1:A" & Sheets("veri").Range("A" & Rows.Count).End(xlUp).Row)
For Each hucre In aralik
If hucre.Value <> "" Then
ThisWorkbook.Sheets("veri").Hyperlinks.Add anchor:=hucre, Address:=hucre, SubAddress:=""
End If
Next hucre

End If
End Sub

 

[jraujr]

Aşağıdaki kodu kullanarak yapabilirsiniz. C1:C1000 aralığını linklerin yer aldığı sütun-satır aralığına göre değiştirirsiniz.

Sub HyperlinkConverter()
   Dim xCell As Range
   For Each xCell In Range("C1:C1000")
      If xCell.Value <> "" Then
         ActiveSheet.Hyperlinks.Add Anchor:=xCell, Address:=xCell.Formula
      End If
   Next xCell
End Sub

Teşekkürler işim çözüldü. Elinize sağlık.

Merhaba,

@muratboz06 'nın gönderisine ek olarak aşağıdaki durumları da değerlendirebilirsiniz.

Verilerin A sütununda olduğunu varsayarsak;
Formülle

=KÖPRÜ(A1)

Worksheet_Change ile

Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, Range("A1:A" & Sheets("veri").Range("A" & Rows.Count).End(xlUp).Row)) Is Nothing Then
Dim aralik As Range
Dim hucre As Range

Set aralik = ThisWorkbook.Sheets("veri").Range("A1:A" & Sheets("veri").Range("A" & Rows.Count).End(xlUp).Row)
For Each hucre In aralik
If hucre.Value <> "" Then
ThisWorkbook.Sheets("veri").Hyperlinks.Add anchor:=hucre, Address:=hucre, SubAddress:=""
End If
Next hucre

End If
End Sub

Teşekkür ederim. 1. si çalışında bunu denemedim. Çalıştığına eminim. İyi günler.

 

[Korhan Ayhan]

Merhaba,

Profilinizde yazan (Default) excel sürüm ve dilini değiştirebilir misiniz?