Kapalı dosyalarda yazdırmak

[1903emre34@gmail.com]

Merhaba,

Aşağıdaki kod aracılığıyla, kapalı dosyalardaki pfd dosyalarını yazdırıyor, word dosyalarıyla birlikte yazdırması için kodlarda nasıl değişiklik yapabiliriz.

Dim secilendizin As String

Sub menu()
   Call Klasor_Sec
   If secilendizin = "" Then
     MsgBox ("Dosya seçimi yapmadın")
     Exit Sub
   End If
   Call pdf_yazdir
End Sub

Sub Klasor_Sec()
  Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
  If Not klasor Is Nothing Then
     kaynak = klasor.self.Path
     If InStr(1, kaynak, "{") > 0 Then GoTo atla
     Set klasor = Nothing
     secilendizin = kaynak
  Else
atla:
     secilendizin = ""
  End If
End Sub


Public Sub pdf_yazdir()

    Dim folder As String
    Dim PDFfilename As String
    
    folder = secilendizin & "\"
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    PDFfilename = Dir(folder & "*.pdf", vbNormal)
    While Len(PDFfilename) <> 0
        Print_PDF folder & PDFfilename
        PDFfilename = Dir()
    Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
    Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
End Sub

 

[Asri]

Not defterinde yazıldı TEST edilmedi.


Kontrol ediniz.

Dim secilendizin As String

Sub menu()
   Call Klasor_Sec
   If secilendizin = "" Then
     MsgBox ("Dosya seçimi yapmadın")
     Exit Sub
   End If
   Call pdf_yazdir
End Sub

Sub Klasor_Sec()
  Set klasor = CreateObject("shell.application").BrowseForFolder(0, "Kaynak Dosyaları İçeren Klasörü Seçin", 50, &H0)
  If Not klasor Is Nothing Then
     kaynak = klasor.self.Path
     If InStr(1, kaynak, "{") > 0 Then GoTo atla
     Set klasor = Nothing
     secilendizin = kaynak
  Else
atla:
     secilendizin = ""
  End If
End Sub

Public Sub pdf_yazdir()

    Dim folder As String
    Dim PDFfilename As String
    
    folder = secilendizin & "\"
    If Right(folder, 1) <> "\" Then folder = folder & "\"
       
    PDFfilename = Dir(folder & "*.pdf", vbNormal)
    While Len(PDFfilename) <> 0
        Print_PDF folder & PDFfilename
        PDFfilename = Dir()
    Wend

    wrdfilename = Dir(folder & "*.docx", vbNormal)
    While Len(wrdfilename) <> 0
        word_yazdir folder & wrdfilename
        wrdfilename = Dir()
    Wend

End Sub

Private Sub Print_PDF(sPDFfile As String)
    Shell "C:\Program Files (x86)\Adobe\Reader 11.0\Reader\AcroRd32.exe /p /h " & Chr(34) & sPDFfile & Chr(34), vbNormalFocus
End Sub

Sub word_yazdir (swrdfile As String)
  Dim objWord
  Dim objDoc
  Set objWord = CreateObject("Word.Application")
  objWord.Visible = False

  Set objDoc = objWord.Documents.Open(swrdfile)
  objDoc.PrintOut
  objDoc.Close
  objWord.Quit
End Sub

 

[1903emre34@gmail.com]

Teşekkürler, sorunsuz çalıştı.

 

[KuTuKa]

ben makroyu çalıştıramadım dosya seçip makroyu çalıştırdığımda tekrardan dosya seç geliyor.

 

[1903emre34@gmail.com]

ben makroyu çalıştıramadım dosya seçip makroyu çalıştırdığımda tekrardan dosya seç geliyor.

Dosya ektedir.

 

[KuTuKa]

emre bey çok teşekkürler ama yineaynı sorun

menü yü tıklıyorum

dosya seç diyip yazdırılacak dosyayı seçiyorum

ya bir işlem yapıp 2. adım olan yazdır gelmiyor yada dosya bulunmaı diyor.

makro içinde benim kaydetmem gereken bir şey olabir mi c sürücüsüne teşekkürler.


istediğim sadece dosya içindeki pdf leri varsa word ü sırayla yazdırabilmek.

 

[KuTuKa]

bu konuda fikri olan var mı ?