Hücre Değeriyle Kayıt Yapmak

[hkaradag]

Merhabalar,
Aşağıdaki tabloyu hazırladım. SONUC sayfasındaki B9 hücresindeki kayıt sırası verisine göre PUAN sayfasından veriler geliyor. SONUC sayfasındaki butonla 2 şey yapmak istiyorum.

SONUC sayfasındaki butonun ilk olarak B9 hücresindeki kayıt sırası ile veriler geldikten sonra, B8 hücresindeki TC Kimlik No bilgisiyle bu sayfanın excel dosyamın bulunduğu yere PDF olarak kaydedilmesini istiyorum. Bu işlem tamamlandıktan sonra butondaki makro kayıt sıra no bilgisini bir arttırarak yeni gelen verilere göre sayfa kaydetme işlemini tamamlamak istiyorum.
Dosyada 10 kayıt verisi varsa ve 10 TC Kimlik No adında 10 PDF dosyam olacak şekilde bir işlem yapacak makroya ihtiyacım var.

Benim bilgimin ötesinde bir işlem olduğundan tecrübelerinize başvurmak istedim. Çok teşekkür ederim.

 

[osman06turgut]

Hocam forumdan araştırma sonucu elde ettiğimi sizinle paylaşıyorum.

 

[osman06turgut]

Vba kod görüntüleme ekranında burayı bulun "C:\Users\Osman\Downloads\" nereye kayıt edecekseniz oranın klasör uzantısını girin.

 

[hkaradag]

@osman06turgut hocam makro PDF kaydetme işini çok güzel yapıyor teşekkür ederim. Makro kayıt işleminde dosya adını B9'dan alıyordu. B8 olarak düzelttim. Butona sürekli basma ihtiyacı duymadan, 1 kez basarak kayıt sıra no bilgisine sahip tüm sonuçları ayrı ayrı kaydetme işlemini yaptırabilir miyiz peki? Bir for döngüsüne ihtiyaç var ama nasıl olur bilmiyorum. 1000 kayıt için 1000 kez basmak zor olacak çünkü.

 

[hkaradag]

@osman06turgut hocam problemi çözdüm. Kodları aşağıya bırakıyorum başkasının işine yarar belki. İlginize çok teşekkür ederim.

Private Sub CommandButton1_Click()

    dosyaAdi = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)
  
    'Do While döngüsü başlangıcı
    Do While Sheets("SONUC").Range("B8").Value <> 0 'B8 hücresi 0 değilse döngüyü çalıştır
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
            "C:\Users\karad\Desktop\YDA_Sonuc_Aciklama\" & Sheets("SONUC").Range("B8").Value & ".pdf", Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
            False
        Range("B9") = Range("B9") + 1
    Loop 'Döngüyü tekrarla
    'Do While döngüsü sonu

End Sub


Sub Pdf_Kaydet()

    dosyaAdi = Left(ActiveWorkbook.Name, InStr(ActiveWorkbook.Name, ".") - 1)
  
    'Do While döngüsü başlangıcı
    Do While Sheets("SONUC").Range("B8").Value <> 0 'B8 hücresi 0 değilse döngüyü çalıştır
        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:=CreateObject("WScript.Shell").SpecialFolders("Desktop") & "\" & dosyaAdi
    Loop 'Döngüyü tekrarla
    'Do While döngüsü sonu

End Sub

 

[osman06turgut]

Rice ederim hocam iyi forumlar.