420 dosyaya birden köprü atamak

[Eser Gökay]

arkadaslar herkese merhaba....


sorum ektedir.


arkadaslar başlıkta kötü atamak demişim. Köprü Atamak olacak. özür dilerim

 

[Eser Gökay]

arkadaslar bu konuda fikri olan yok mu?

 

[Ferhat Pazarçevirdi]

Önce tüm butonları siliniz. Sonra aşağıdaki kodu bir modul sayfasına kopyalayınız ve çalıştırınız.

NOT : 420 dosyanızın ve makro yazdığınız dosyanın aynı dizin altında olduğu varsayılmıştır. Eğer değilse; koddaki "thisworkbook.path" yerine, uygun bir yol yazın.

Sub link()
Set sh = Sheets("Sayfa1")
son = sh.Cells(65536, 1).End(xlUp).Row
For Each hucre In Range("B2:M" & son)
   Sirket = hucre.Row - 1
   Ay = hucre.Column - 1
   If Len(Sirket) = 1 Then: Sirket = "00" & Sirket: GoTo f1
   If Len(Sirket) = 2 Then: Sirket = "0" & Sirket: GoTo f1
f1:
   If Len(Ay) = 1 Then Ay = "0" & Ay
   sh.Hyperlinks.Add anchor:=hucre, Address:=ThisWorkbook.Path & "\" & Sirket & "-" & Ay & ".xls", TextToDisplay:=Sirket & "-" & Ay & ".xls"
Next
Set sh = Nothing
End Sub

 

[Necdet]

Butonları silmek için uğraşmayın.

Public Sub sil()
Sheets(1).Shapes.SelectAll
Selection.Delete
End Sub

 

[Eser Gökay]

cok tesekkur ediyorum değerli üstadlar