Soru Sayfa isimlerini listelemek ve köprülerini oluşturmak

T

towcu77

Katılım
14 Şubat 2005
Mesajlar
7
Arkadaşlar merhabalar,
Kargo ve diğer gönderilere etiket yazdırmak için kullanmakta olduğum bir excel dosyam var,
her sayfada müşteri sevk adresi bilgileri mevcut.Daha önceki konularda bir formül buldum ama benim tarafımda bazı farklı isteklerim olacak :)
daha önceki excel dosyasında yaklaşık 3000 sayfa vardı ve vakti zamanında bunlar için sayfa1'e tek tek sayfa isimleri elle yazılmış ve köprü yapılmış,
yeni bir dosya oluşturacağım ve istediğim;
Sayfa1'e (ya da anasayfaya) excel dosyasındaki tüm sayfa isimlerinin köprülü bir şekilde gelmesi,
aşağıdaki formülde her sayfada a1 hücresine verilen anasayfa linkinin g4 hücresine verilmesi,
yine aşağıdaki formülde her kolona 25 adet olarak verilmiş, ben tek kolonda aşağı doğru ilerlemesini istiyorum (ki ctrl+f ile istediğim sayfayı bulabiliyorum)
ve son olarak ta her yeni sayfa eklendiğinde veya sayfa ismi değiştiğinde anasayfadaki fihristte aynı değişikliğin otomatik yapılabilmesi,

ne dersiniz arkadaşlar, bu hasta yaşar mı :):)

bu acemi arkadaşınıza yardımlarınız için şimdiden teşekkür ediyorum,


eski konuların içerisinde bulduğum formül aşağıdaki gibidir,
ayrıca formül için sayın @asri'ye teşekkür ediyorum,

SayfaIndex adında sayfayı yeniden oluşturup, tüm sayfaların sayfa adlarını bu sayfada her bir kolonda 25 sayfa olacak şekilde köprü yapar.
Aynı zamanda her bir sayfanın A1 hücresine SayfaIndex sayfasına köprü yapar.
Tüm sayfaların A1 hücreleri boş olmak zorundadır.

Kod:
Sub SayfaIndex()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If WorksheetExists("SayfaIndex") Then Sheets("SayfaIndex").Delete
Set NewSh = Sheets.Add(Before:=Sheets(1))
NewSh.Name = "SayfaIndex"

Cells.ClearContents
kolon = 1
satir = 2
Cells(1, 1).Select
ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"

For i = 2 To Sheets.Count
Cells(satir, kolon).Value = Sheets(i).Name
Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(1, 1), Address:="", SubAddress:="SayfaIndex!A1", TextToDisplay:="SayfaIndex"
ActiveSheet.Hyperlinks.Add Anchor:=Cells(satir, kolon), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
satir = satir + 1
If satir = 26 Then
kolon = kolon + 1
satir = 2
End If
Next i

Cells.Select
Cells.EntireColumn.AutoFit
Range("E1").Select

Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
 
Asri

Asri

Katılım
24 Nisan 2005
Mesajlar
3,653
Excel Vers. ve Dili
Office 2016 EN 64 Bit
Altın Üyelik Bitiş Tarihi
25/05/2022
Aşağıdaki şekilde deneyiniz.

Anasayfa her aktif edildiğinde index yeniden oluşturulmaktadır.
20-30 sayfada pek fark edilmiyor ancak 1000-3000 sayfada nasıl bir durum oluşuyor deneyip bildirir misiniz?


Kod: 
'Anasayfa   sayfasının kod bölümüne aşağıdaki kodu ekleyin.
Private Sub Worksheet_Activate()
  Call linkolustur
End Sub

'Modul1'e aşağıdaki kodu ekleyin.
Sub linkolustur()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If WorksheetExists("Anasayfa") Then
   Cells.Clear
Else
    Set NewSh = Sheets.Add(Before:=Sheets(1))
    NewSh.Name = "Anasayfa"
End If

For i = 2 To Sheets.Count
Sheets("Anasayfa").Cells(i, "A").Value = Sheets(i).Name
Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(4, "G"), Address:="", SubAddress:="Anasayfa!A1", TextToDisplay:="Anasayfa"
Sheets("Anasayfa").Hyperlinks.Add Anchor:=Sheets("Anasayfa").Cells(i, "A"), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next i

Sheets("Anasayfa").Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
 
T

towcu77

Katılım
14 Şubat 2005
Mesajlar
7
@asri hocam selamlar,
kullandığım excelde şu an aktif olarak 3269 sayfa var,ilk mesajımda da bahsettiğim üzere hepsinde adres mevcut, ayrıca firma logosu da var,
logodan kaynaklı hem dosya boyutu büyüyor (16 mb. ulaştı), hem de excel yavaş çalışmaya başlıyor, bu yüzden yeni ve güncel bir dosya oluşturacağım (logosuz :) )
ama işin özü verdiğiniz kodlar süper çalışıyor, çok çok teşekkür ediyorum, (y)(y)(y)
 
T

towcu77

Katılım
14 Şubat 2005
Mesajlar
7
PriveT' Alıntı:
Merhaba,
Bir üstadımız yapmış, ben de arşivime eklemişim.
Kim olduğunu malesef hatırlamıyorum. Yapanın emeğine sağlık.
Sanırım istediğiniz böyle bir dosya.

https://dosya.co/svei3zwubzmn/sayfaları_ana_sayfaya_köprüle_MAKROSU.xls.html
Genişletmek için tıkla ...
@PriveT hocam merhabalar,
verdiğiniz dosya da işimi görüyor fakat, @asri hocanın verdiği kodlar ile tabiri caizse cuk oturdu,
ilginiz ve yardımlarınız için çok teşekkür ederim,
saygılar :)
 
T

towcu77

Katılım
14 Şubat 2005
Mesajlar
7
asri' Alıntı:
Aşağıdaki şekilde deneyiniz.

Anasayfa her aktif edildiğinde index yeniden oluşturulmaktadır.
20-30 sayfada pek fark edilmiyor ancak 1000-3000 sayfada nasıl bir durum oluşuyor deneyip bildirir misiniz?


Kod: 
'Anasayfa   sayfasının kod bölümüne aşağıdaki kodu ekleyin.
Private Sub Worksheet_Activate()
  Call linkolustur
End Sub

'Modul1'e aşağıdaki kodu ekleyin.
Sub linkolustur()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
If WorksheetExists("Anasayfa") Then
   Cells.Clear
Else
    Set NewSh = Sheets.Add(Before:=Sheets(1))
    NewSh.Name = "Anasayfa"
End If

For i = 2 To Sheets.Count
Sheets("Anasayfa").Cells(i, "A").Value = Sheets(i).Name
Sheets(i).Hyperlinks.Add Anchor:=Sheets(i).Cells(4, "G"), Address:="", SubAddress:="Anasayfa!A1", TextToDisplay:="Anasayfa"
Sheets("Anasayfa").Hyperlinks.Add Anchor:=Sheets("Anasayfa").Cells(i, "A"), Address:="", SubAddress:="'" & Sheets(i).Name & "'!A1", TextToDisplay:=Sheets(i).Name
Next i

Sheets("Anasayfa").Cells.EntireColumn.AutoFit
Application.DisplayAlerts = True
Application.ScreenUpdating = True
End Sub

Public Function WorksheetExists(ByVal WorksheetName As String) As Boolean
On Error Resume Next
WorksheetExists = (Sheets(WorksheetName).Name <> "")
On Error GoTo 0
End Function
Genişletmek için tıkla ...
@asri hocam selamlar,
kullandıkça ihtiyaçlar ortaya çıkıyor :)
bu kodun içine anasayfaya gelen linklerin alfabetik sıra ile gelmesi için ekleme yapabilir miyiz acaba ?
 
T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,612
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Merhaba,
Asri hocanın link oluştur makrosunun son satırı olarak
Kod: 
sonsatir = Cells(Rows.Count, "A").End(3).Row
Range("A2:A" & sonsatir).Sort [A2], Order1:=xlAscending
ekleyiniz.
İyi çalışmalar
 
Son düzenleme:
T

Tevfik_Kursun

Altın Üye
Katılım
30 Temmuz 2012
Mesajlar
3,612
Excel Vers. ve Dili
Office 2016 Pro - Türkçe 64 Bit
Altın Üyelik Bitiş Tarihi
12-02-2029
Rica ederim,
İyi çalışmalar
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst