Sayfaları pdf olarak ayırmak ve Link'lemek.

[ermanusta]

Ekte bir çalışma kitabı mevcut. bu kitap içerisindeki bilgiler, asıl kullandığım "çalışma kitabı" içerisindeki bilgilerin 3 sayfalık birebir kopyasıdır. yapmak istediklerimi kitap içerisinde bakınca basit bir şekilde anlayacağınızı umud ediyorum. aşağıda da kitabın içerisinde örnekler üzerine yazdıklarımın bir kopyasını yapıştırıyorum.

bu konuda yardımlarınızı rica ediyorum.

bu çalışma kitabı, fatura kestiğim müşterilerimi takip etmek için oluşturduğum basit bir muhasebe hesabı içeren bir "çalışma kitabıdır".

bu Kitabın içinde Fatura numarası kadar sayfa mevcut.
her numara üzerine çift tıklayınca tıkladığım sayfa numarasına geçen bir kod da mevcut

yapmak istediğim ise şu
şu anda bu kitap içinde 100 lerce fatura mevcut ve excell çok ağırlaştı.
bu sayfaları kitaptan ayırmak istiyorum
ayırdığım bu sayfalar hem excell hem pdf formatında kitaptan ayrılıp bu kitabın bulunduğu "Klasör" içerisine bir alt klasör olan "faturalar" klasörüne kaydedilebilir mi?
eğer bu şekilde kayıt edilebilir ise, bu tabloyu açtığımda "fatura numarası" üzerine çift tıkladığımda bu faturaya ait pdf dosyasını otomatik olarak açabilirmiyim?
100 lerce sayfa mevcut olduğu için bunu bir kod yardımıyla yapmam gerektiğini düşündüm.

 

[ermanusta]

konu guncel. yardimci olabilecek arkasaslar var mi ?
PDF olmasa da olur

 

[Korhan Ayhan]

Asıl dosyanızı yedekledikten sonra aşağıdaki kodu deneyiniz.

Option Explicit

Sub FATURA_KAYDET()
    Dim S1 As Worksheet, Klasör As String, Sayfa As Worksheet, Sayfa_Bul As Range
    
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    Set S1 = Sheets("Faturalar")
    Klasör = ThisWorkbook.Path & "\Faturalar\"
    
    If Dir(Klasör, vbDirectory) = "" Then MkDir (Klasör)
    
    For Each Sayfa In ThisWorkbook.Worksheets
        If Sayfa.Name <> "Faturalar" Then
            If WorksheetFunction.CountA(Sayfa.Cells) > 0 Then
                Set Sayfa_Bul = S1.Range("A:A").Find(Sayfa.Name, , , xlWhole)
                If Not Sayfa_Bul Is Nothing Then
                    ActiveSheet.Hyperlinks.Add Anchor:=Sayfa_Bul, _
                    Address:=Klasör & Sayfa.Name & ".pdf"
                End If
                Sayfa.Copy
                ActiveWorkbook.ExportAsFixedFormat _
                Type:=xlTypePDF, Filename:=Klasör & Sayfa.Name & ".pdf", _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=False
                
                ActiveWorkbook.SaveAs Klasör & Sayfa.Name & ".xlsx", 51
                ActiveWorkbook.Close 0
                Sayfa.Delete
            End If
        End If
    Next
    
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
    
    MsgBox "İşleminiz tamamlanmıştır.", vbInformation
End Sub

 

[ermanusta]

Korhan bey
makronuz tüm dosyaları birbirinden ayırıp hepsini aynı klasörde kaydediyor.
acaba örnek dosyadaki gibi sadece A:A stünundaki hücrelerden üzerine tıkladığımız sayfayı ayırıp ayrı klasörlerde kaydetme şansımız var mı. tabi bide linki o hücredeki rakamın dosyasına gitmesi gerek ki sizin yaprığınız gibi

 

[ermanusta]

sorunumu ararken tekrar kendi açtığım konuya denk geldim, hortlatmış gibi oldum fakat konu günceldir arkadaşlar