Hızlı Bordro Yazdırmak

htsumer · 3 Haziran 2013

"Bordro" Sayfasında C1 Hücresine TC Kimlik numarası yazılarak bordro verileri alınıyor. TC Nosunu yazdığımızda o kişiye ait mali bilgiler tabloya dökülüp yazdırılıyor.

Benim istediğim Bu yazdırma işlemini otomatik yapmak.

"Puantaj Yeni" Sayfasının C4 Sütunundan aşağıya kadar 50 civarında TC Kimlik nosunu makro ile "Bordro" Sayfasının C1 hücresine yapıştırıp yazdıracak bu döngü "Puantaj Yeni" sayfasının C4 hücresindeki en son TC numarasına kadar devam edecek.

Kısaca

"Puantaj Sayfası" C5 Kopya "Bordro" Sayfası C1 yapıştır yazdır
"Puantaj Sayfası" C6 Kopya "Bordro" Sayfası C1 yapıştır yazdır
"Puantaj Sayfası" C7 Kopya "Bordro" Sayfası C1 yapıştır yazdır
...
..
.

Şimdiden teşekkür ederim.

YUSUF44 · 3 Haziran 2013

Aşağıdaki kodları bir modüle ekleyip deneyiniz. Ancak deneme yapmadan önce puantaj sayfasındaki kişileri azaltın ki makro çalıştığında tüm listeyi yazdırmasın:

Kod:

Sub yazdir()
Set s1 = Sheets("Bordro")
Set s2 = Sheets("Puantaj Yeni")
For a = 4 To s2.[c65536].End(3).Row
s1.[c1] = s2.Cells(a, "c")
s1.PrintOut
Next
End Sub

htsumer · 31 Ekim 2013

Teşekkür ederim. Bu mesajımı atlamışım görmedim..

Tek sıkıntı iki kişi olmasına rağmen bir sürü kağıt çıkarttı iki kişi den sonra boş çıkarıyor o hücrelerde formül var sanırım onları veri olarak görüyor.
bunu yazdır olarak zor oluyor yani çıktı yönünden bunu PDF formatında alabilirmiyiz..
Saygılar

htsumer · 31 Ekim 2013

Mesajı düzenledim..

Zeki Gürsoy · 31 Ekim 2013

Her printout dan sonra 3-5 sn. kadar bekletme kodu ilave edin. Döngü çok hızlı çalışıyor.

htsumer · 1 Kasım 2013

Sorumu yenileyerek başlamak istiyorum.

-"Bordro" Sayfasının B6 Hücresinden başlayıp, B45 Hücresine kadar TC Kimlik numarları yazılıyor ama bazen bu sonuna kadar olmayabiliyor. Yani B6'dan B10 kadar var diyelim.
-Diğer boş kalan hücrelerde formüller var yani TC'leri başka Sayfadan almak üzere.
-B6 Hücresinden TC Kimliğ alıp, "Bordro Hazırlama" Sayfasının C1 hücresine yapıştırıp, Bordro Hazırlama sayfasını PDF olarak herhangi bir yere kaydedecek, kaydederken dosya adını B9 hücresinden alacak.
-Bu döngü Bordro sayfasındaki en son TC yazılı kişiye kadar sürecek.

Mantığı böyle, teşekkürler.

htsumer · 2 Kasım 2013

Bu konuda yardımlarınızı bekliyorum..

htsumer · 4 Kasım 2013

Şuna bir el atsak arkadaşlar..

htsumer · 4 Kasım 2013

PDF Oluşturma kodlarını siteden buldum ve kendime uyarladım,
Fonksiyon Kodu:

Kod:

Option Explicit

'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module

Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")

            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function

Uygulama Kodu

Kod:

Sub Bilgileri_PDF_Olarak_Kaydet()
dosya_adı = ActiveWorkbook.Name
'xls dosyasında hangi aralığın PDF'ye dönüştürüleceğini belirledik yani B1:I20
Range("A2:F22").Select
' PDF dosyasını isimlendirmek için ad tanımlıyoruz:
Musteri_adi = Sheets("Bordro Hazırlama").Range("B11").Value & " " & [B12]
Musteri_soyadi = Sheets("Bordro Hazırlama").Range("B9").Value
strdate = Format(Now, "dd-mm-yyyy ")
' PDF dosyası oluşturuyoruz.
' PDF'nin kayıt yeri XLS dosyası neredeyse orada olacak.

Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & Musteri_soyadi & "-" & Musteri_adi & "-" & strdate, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
'OpenAfterPublish:=True değerini False seçersek kayıt sonrası PDF otomatik açılmayacak.
End Sub

tek sorun kaldı

"Kütük" Sayfası A2 Hücresinden başlayıp aşağıya kadar TC Kimlik numaralarının (Aşağı sıralarda birden fazla TC no var) , sırayla ve TC olmayan satıra kadar;

"Bordro Hazırlama" Sayfasının C1 hücresine yapıştırılıp, PDF kaydedecek. Bu işlem "Kütük" sayfasındaki verilerin sonuna kadar devam edecek.

htsumer · 4 Kasım 2013

Şu kod ile istediğimi gerçekleştirdim

Kod:

Sub yazdir()
Set s1 = Sheets("Bordro Hazırlama")
Set s2 = Sheets("Puantaj Yeni")
For a = 4 To s2.[c65536].End(3).Row
s1.[c1] = s2.Cells(a, "c")
Bilgileri_PDF_Olarak_Kaydet
Next
End Sub

Ama TC kimlik nosu boş kadırınca hücrede hata olayından dolayı

Bilgileri_PDF_Olarak_Kaydet Makrosunun şu satırında haliyle hata verdi.

Kod:

Musteri_adi = Sheets("Bordro Hazırlama").Range("B11").Value & " " & [B12]

htsumer · 4 Kasım 2013

Sorumu kendim hallettim.. Teşekkürler :hihoho:

Kod:

On Error Resume Next ile

Kodları bitmiş hali
FONKSİYON KODU

Kod:

Option Explicit

'The code below are used by the macros in the other two modules
'Do not change the code in the functions in this module

Function RDB_Create_PDF(Myvar As Object, FixedFilePathName As String, _
                        OverwriteIfFileExist As Boolean, OpenPDFAfterPublish As Boolean) As String
    Dim FileFormatstr As String
    Dim Fname As Variant

    'Test If the Microsoft Add-in is installed
    If Dir(Environ("commonprogramfiles") & "\Microsoft Shared\OFFICE" _
         & Format(Val(Application.Version), "00") & "\EXP_PDF.DLL") <> "" Then

        If FixedFilePathName = "" Then
            'Open the GetSaveAsFilename dialog to enter a file name for the pdf
            FileFormatstr = "PDF Files (*.pdf), *.pdf"
            Fname = Application.GetSaveAsFilename("", filefilter:=FileFormatstr, _
                                                  Title:="Create PDF")

            'If you cancel this dialog Exit the function
            If Fname = False Then Exit Function
        Else
            Fname = FixedFilePathName
        End If

        'If OverwriteIfFileExist = False we test if the PDF
        'already exist in the folder and Exit the function if that is True
        If OverwriteIfFileExist = False Then
            If Dir(Fname) <> "" Then Exit Function
        End If

        'Now the file name is correct we Publish to PDF
        On Error Resume Next
        Myvar.ExportAsFixedFormat _
                Type:=xlTypePDF, _
                Filename:=Fname, _
                Quality:=xlQualityStandard, _
                IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, _
                OpenAfterPublish:=OpenPDFAfterPublish
        On Error GoTo 0

        'If Publish is Ok the function will return the file name
        If Dir(Fname) <> "" Then RDB_Create_PDF = Fname
    End If
End Function

YAPISAL KODU

Kod:

Sub yazdir()
On Error Resume Next
Set s1 = Sheets("Bordro Hazırlama")
Set s2 = Sheets("Puantaj Yeni")
For a = 4 To s2.[c65536].End(3).Row
s1.[c1] = s2.Cells(a, "c")
Bilgileri_PDF_Olarak_Kaydet
Next
End Sub

Sub Bilgileri_PDF_Olarak_Kaydet()
dosya_adı = ActiveWorkbook.Name
Range("A2:F22").Select
Musteri_adi = Sheets("Bordro Hazırlama").Range("B11").Value & " " & [B12]
Musteri_soyadi = Sheets("Bordro Hazırlama").Range("B9").Value
strdate = Format(Now, "dd-mm-yyyy ")
Selection.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Application.ThisWorkbook.Path & "\" & Musteri_soyadi & "-" & Musteri_adi & "-" & strdate, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
End Sub

Hızlı Bordro Yazdırmak

htsumer

Altın Üye

YUSUF44

Destek Ekibi

htsumer

Altın Üye

htsumer

Altın Üye

Zeki Gürsoy

Uzman

htsumer

Altın Üye

htsumer

Altın Üye

htsumer

Altın Üye

htsumer

Altın Üye

htsumer

Altın Üye

htsumer

Altın Üye