• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

PDF'ten Sayfa Yazdırma

Bu konuda sonuca ulaşabildiniz mi?
 
Kod:
Declare PtrSafe Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" ( _
    ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, _
    ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
 
Public Function PrintPDF(xlHwnd As Long, FileName As String) As Boolean
Dim X As Long

On Error Resume Next
X = ShellExecute(xlHwnd, "Open", FileName, 0&, 0&, 3)

If Err.Number > 0 Then
    MsgBox Err.Number & ": " & Err.Description
    PrintPDF = False
Else
    PrintPDF = True
End If
On Error GoTo 0
End Function

Sub PDF_Yazdir_Mahmut()

    Dim strPth As String, strFile As String, strPage As String, strCopy As String
    
    strPth = Range("A1")
    strFile = Range("B1")
    strPage = Range("C1")
    strCopy = Range("D1")
  
    If Range("A1").Value = "" Then
        MsgBox "Lütfen PDF dosyasının konumunu giriniz!", vbCritical
        Range("A1").Select
        Exit Sub
    End If

    If Range("B1").Value = "" Then
        MsgBox "Lütfen PDF dosyasının adını giriniz!", vbCritical
        Range("B1").Select
        Exit Sub
    End If

    If Range("C1").Value = "" Then
        MsgBox "Lütfen yazdırmak istediğiniz sayfanın numarasını giriniz!", vbCritical
        Range("B1").Select
        Exit Sub
    End If
    
    If Range("D1").Value = "" Then
        MsgBox "Lütfen çıktı sayısını giriniz!", vbCritical
        Range("B1").Select
        Exit Sub
    End If
  
    If Not PrintPDF(0, strPth & strFile) Then
    MsgBox "Printing failed"
End If

    Application.Wait Now + TimeSerial(0, 0, 3)
    SendKeys "^p", True
    SendKeys "{Tab 1}", True
    SendKeys Range("D1").Value, True
    SendKeys "{Tab 7}", True
    SendKeys "{Down 2}", True
    SendKeys "{Tab 1}", True
    SendKeys Range("C1").Value, True
    SendKeys "{Tab 10}", True
    Application.Wait Now + TimeSerial(0, 0, 3)
    SendKeys "{Enter}", True
    Application.Wait Now + TimeSerial(0, 0, 3)
    SendKeys "%{F4}", True

    MsgBox "Yazdırma İşlemi Tamamlandı Komutan Logar"
End Sub

Korhan bey, sizin vermiş olduğunuz kod üzerinde bazı değişiklikler yapılarak en son bu halini aldı ve sıkıntısız bir şekilde çalışıyor. Bizzat denedim, çıktıyı veriyor.
A1 sütununa dosya yolunu yazıyorum.
B1 sütununa PDF dosyamın adını.
C1 sütununa "kaçıncı sayfadan çıktı almak istediğimi."
D1 sütununa ise kaç adet çıktı almak istediğimi. Bu konuda çok yardımcı oldunuz, tekrardan çok teşekkür ederim.
 
Kod bu haliyle "ACROBAT" gerekmeden, "ADOBE READER" ile çalışıyor.
 
Bilgi için teşekkürler..
 
Adobe Acrobar ücretli bir program.
Ücretsiz olarak pdf birleştirmek için pdftk.exe programı incelenebilir.
Komut satırında parametre ile çalışır ve excel vba içinde kullanılabilir.
 
Adobe Reader bu işlemler için yeterli olmuyor. Bunu konudaki ilk mesajlarda belirtmiştik.

İşlem için Adobe Acrobat Pro DC uygulamasına ihtiyaç duyuluyor.
 
Geri
Üst