- Katılım
- 15 Mart 2005
- Mesajlar
- 42,603
- Excel Vers. ve Dili
- Microsoft 365 Tr-En 64 Bit
Bu konuda sonuca ulaşabildiniz mi?
DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
Altın Üyelik Hakkında Bilgi
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