Çözüldü Excel VBA da toplu pdf kaydetme

[erd5334]

Arkadaşlar merhaba, userform listbox da listelenen tc numaralarına göre sayfa1 de bulunan değerleri sayfa4 te alt alta yazıp daha sonra sayfa4 deki verileri masaüstünde belirlediğimiz klasöre tcno.pdf şeklinde kaydetmek istiyorum. ve bu lstbox item sayısı kadar döngü ile olacak, bununla ilgili yardımcı olur musunuz. birde sayfa 4 e veriler geldikten sonra toplam satırının en altına toplam değer gelecektir.

 

[AdemCan]

Merhaba, kodu çalıştırmadan önce aşağıdaki düzenlemeleri yapın.
1- Kod içerisinde klasör yolunu belirleyin.
konum = "Kayıt Edilecek Klasör Yolunu Buraya Yazın"

2- Sayfadaki butonun pdf dosyalarında görünmemesi için özellikler bölümünden PrintObject False seçin.


3- Sayfa4 de toplamları göstermek için Aj2 hücresine =ALTTOPLAM(9;AJ3:AJ1000) formülünü yazın.

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, son1 As Long, son2 As Long, sayi As Long, tc As Double
Dim konum As String, uzanti As String, i As Long, x As Long
Set s1 = Sayfa1: Set s2 = Sayfa2
son1 = s1.Cells(Rows.Count, 1).End(3).Row: son2 = s2.Cells(Rows.Count, 1).End(3).Row
konum = "Kayıt Edilecek Klasör Yolunu Buraya Yazın"
uzanti = ".pdf"
sayi = ListBox1.ListCount
soru = MsgBox("Listede bulunan " & sayi & " kişi için puantaj oluşturulsun mu?", vbQuestion + vbYesNo, "")
If soru = vbYes Then
    s2.Range("A3:AJ" & son2 + 1).Clear
    For x = 0 To ListBox1.ListCount - 1
        son2 = s2.Cells(Rows.Count, 1).End(3).Row
        tc = ListBox1.List(x, 0)
        For i = 4 To son1
            If s1.Cells(i, 1) = tc Then
            son2 = son2 + 1
                s1.Range("A" & i & ":AJ" & i).Copy s2.Range("A" & son2)
            End If
        Next i
    s2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=konum & tc & uzanti
    son2 = s2.Cells(Rows.Count, 1).End(3).Row
    s2.Range("A3:AJ" & son2 + 1).Clear
    Next x
    MsgBox "İşlem tamamlandı.", vbInformation, ""
Else
    MsgBox "İşlem iptal edildi.", vbInformation, ""
End If
Application.ScreenUpdating = True
End Sub

 

[erd5334]

Merhaba, kodu çalıştırmadan önce aşağıdaki düzenlemeleri yapın.
1- Kod içerisinde klasör yolunu belirleyin.
konum = "Kayıt Edilecek Klasör Yolunu Buraya Yazın"

2- Sayfadaki butonun pdf dosyalarında görünmemesi için özellikler bölümünden PrintObject False seçin.
Ekli dosyayı görüntüle 248535

3- Sayfa4 de toplamları göstermek için Aj2 hücresine =ALTTOPLAM(9;AJ3:AJ1000) formülünü yazın.
Ekli dosyayı görüntüle 248536

Private Sub CommandButton1_Click()
Application.ScreenUpdating = False
Dim s1 As Worksheet, s2 As Worksheet, son1 As Long, son2 As Long, sayi As Long, tc As Double
Dim konum As String, uzanti As String, i As Long, x As Long
Set s1 = Sayfa1: Set s2 = Sayfa2
son1 = s1.Cells(Rows.Count, 1).End(3).Row: son2 = s2.Cells(Rows.Count, 1).End(3).Row
konum = "Kayıt Edilecek Klasör Yolunu Buraya Yazın"
uzanti = ".pdf"
sayi = ListBox1.ListCount
soru = MsgBox("Listede bulunan " & sayi & " kişi için puantaj oluşturulsun mu?", vbQuestion + vbYesNo, "")
If soru = vbYes Then
    s2.Range("A3:AJ" & son2 + 1).Clear
    For x = 0 To ListBox1.ListCount - 1
        son2 = s2.Cells(Rows.Count, 1).End(3).Row
        tc = ListBox1.List(x, 0)
        For i = 4 To son1
            If s1.Cells(i, 1) = tc Then
            son2 = son2 + 1
                s1.Range("A" & i & ":AJ" & i).Copy s2.Range("A" & son2)
            End If
        Next i
    s2.ExportAsFixedFormat Type:=xlTypePDF, Filename:=konum & tc & uzanti
    son2 = s2.Cells(Rows.Count, 1).End(3).Row
    s2.Range("A3:AJ" & son2 + 1).Clear
    Next x
    MsgBox "İşlem tamamlandı.", vbInformation, ""
Else
    MsgBox "İşlem iptal edildi.", vbInformation, ""
End If
Application.ScreenUpdating = True
End Sub

Hocam çok teşekkür ederim harika oldu.

 

[AdemCan]

Rica ederim.