Adet Girerek Pdf Print Yardım

[hasanyaprak]

Aşağıdaki gibi bir makro kullanıyorum. Exceldeki A sutunundaki listeye göre klasör altındaki pdfleri yazıcıya gönderiyor. Yazıcıya gönderme sırasında adet bilgisi girilmesi konusunda desteğinize ihtiyaç duymaktayım.

Ayrıca A4 olarak gidiyor A3 kağıt tipide seçilebilir mi? Şimdiden teşekkür ederim.


Private Sub CommandButton3_Click()
Dim belge As String
Application.ScreenUpdating = False
On Error Resume Next
For sat = 2 To Cells(Rows.Count, "A").End(3).Row
belge = "\\buzkapsrv\Groups\ortak\2022_ARGE_PROJELERI\01_KLASÖR_DATA_DUZENLEME\TASARIM_DOKUMANLARI\" & Cells(sat, 1).Text & ".pdf"
If Dir(belge) <> "" Then _
CreateObject("Shell.Application").Namespace(0).ParseName(belge).InvokeVerb ("Print")
Application.Wait Now + TimeSerial(0, 0, 3)
Next

MsgBox "işlem tamam"
Application.ScreenUpdating = True

End Sub

 

[Korhan Ayhan]

Linkteki konunun belki faydası olabilir.

PDF'ten Sayfa Yazdırma

Öncelikle herkese merhaba, Excel dosyamda A1 hücresinde yazan değer (111) PDF dosyamın ismi, B1 hücresinde yazan değer (10) ise PDF dosyamdaki sayfa numarası. Örneğin, makroya tıkladığımda "111.pdf" isimli dosyanın, 10. Sayfadan 2 adet çıktı alsın istiyorum. Nasıl yapılabilir

www.excel.web.tr

 

[hasanyaprak]

Linkteki konunun belki faydası olabilir.

PDF'ten Sayfa Yazdırma

Öncelikle herkese merhaba, Excel dosyamda A1 hücresinde yazan değer (111) PDF dosyamın ismi, B1 hücresinde yazan değer (10) ise PDF dosyamdaki sayfa numarası. Örneğin, makroya tıkladığımda "111.pdf" isimli dosyanın, 10. Sayfadan 2 adet çıktı alsın istiyorum. Nasıl yapılabilir

www.excel.web.tr

Korhan bey merhaba,

Gönderdiğiniz linkte sanırım toplu pdf dosyası var ve oradan çıktı almaya çalışmışlar. Oradakini maalesef uyarlayamadım.
Örnek bir dosya ekledim. Bendeki kod çalışıyor sadece çıktı almadan önce kaç kopya almamı sormasını istedim. Yada A sutununda liste var B sutununda karşılarına çıktı adeti yazabilirim. Karşısındaki adete bakarak çıktı alabilir.

 

[Korhan Ayhan]

Öncelikle paylaştığınız dosyanızda bir bilgi yok. Bomboş...

Sizin kullandığınız kod çalışıyorsa aşağıdaki düzenleme işinize yarayacaktır. B sütununa yazdırmak istediğiniz adetleri yazmalısınız.

A4-A3 kağıt ayarı için 2. bir yazıcı tanımlamanızı tavsiye ederim. Daha kolay sonuç alırsınız.

Private Sub CommandButton3_Click()
    Dim Belge As String, X As Long, Y As Byte
   
    Application.ScreenUpdating = False
   
    On Error Resume Next
   
    For X = 2 To Cells(Rows.Count, "A").End(3).Row
        Belge = "\\buzkapsrv\Groups\ortak\2022_ARGE_PROJELERI\01_KLASÖR_DATA_DUZENLEME\TASARIM_DOKUMANLARI\" & Cells(X, 1).Text & ".pdf"
        If Dir(Belge) <> "" Then
            For Y = 1 To Cells(X, 2)
                CreateObject("Shell.Application").Namespace(0).ParseName(Belge).InvokeVerb ("Print")
                Application.Wait Now + TimeSerial(0, 0, 3)
            Next
        End If
    Next
   
    Application.ScreenUpdating = True
   
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

 

[hasanyaprak]

Öncelikle paylaştığınız dosyanızda bir bilgi yok. Bomboş...

Sizin kullandığınız kod çalışıyorsa aşağıdaki düzenleme işinize yarayacaktır. B sütununa yazdırmak istediğiniz adetleri yazmalısınız.

A4-A3 kağıt ayarı için 2. bir yazıcı tanımlamanızı tavsiye ederim. Daha kolay sonuç alırsınız.

Private Sub CommandButton3_Click()
    Dim Belge As String, X As Long, Y As Byte
  
    Application.ScreenUpdating = False
  
    On Error Resume Next
  
    For X = 2 To Cells(Rows.Count, "A").End(3).Row
        Belge = "\\buzkapsrv\Groups\ortak\2022_ARGE_PROJELERI\01_KLASÖR_DATA_DUZENLEME\TASARIM_DOKUMANLARI\" & Cells(X, 1).Text & ".pdf"
        If Dir(Belge) <> "" Then
            For Y = 1 To Cells(X, 2)
                CreateObject("Shell.Application").Namespace(0).ParseName(Belge).InvokeVerb ("Print")
                Application.Wait Now + TimeSerial(0, 0, 3)
            Next
        End If
    Next
  
    Application.ScreenUpdating = True
  
    MsgBox "İşleminiz tamamlanmıştır."
End Sub

Korhan bey tekrar merhaba,
Makrolu dosyayı değilde boş dosyayı yanlışlıkla eklemişim. Çok özür. Düzenlediğiniz kod gayet güzel çalışıyor. Desteğiniz için teşekkür ederim.