bjk55
Altın Üye
- Katılım
- 29 Mart 2010
- Mesajlar
- 184
- Excel Vers. ve Dili
- TÜRKÇE - MİCROSOFT OFFİCE PROFESSİONAL PLUS 2021
- Altın Üyelik Bitiş Tarihi
- 05-03-2036
Teşekkür ederim PDF için nasıl ayarlamam gerekiyorDeneyiniz.
C++:Option Explicit Sub Seri_Yazdir() Dim S1 As Worksheet, S2 As Worksheet, No As Long Set S1 = Sheets("TESLİM TESELLÜM") Set S2 = Sheets("LİSTE") For No = 1 To S2.Cells(Rows.Count, 1).End(3).Row Step 4 If No > 0 Then S1.Range("H4") = No S1.PrintOut Copies:=1 End If Next MsgBox "Verileriniz yazıcıya gönderilmiştir.", vbInformation Set S1 = Nothing Set S2 = Nothing End Sub
Option Explicit
Sub Seri_Yazdir_PDF()
Dim WF As WorksheetFunction, S1 As Worksheet, S2 As Worksheet
Dim Baslangic_No As Variant, Bitis_No As Variant, X As Long
Set S1 = Sheets("TESLİM TESELLÜM")
Set S2 = Sheets("LİSTE")
Set WF = WorksheetFunction
Baslangic_No = InputBox("Lütfen yazdırmak istediğiniz başlangıç numarasını giriniz...", , WF.Min(1, Sheets("LİSTE").Range("A:A")))
Bitis_No = InputBox("Lütfen yazdırmak istediğiniz bitiş numarasını giriniz...", , WF.Max(Sheets("LİSTE").Range("A:A")))
If Baslangic_No = "" Or Bitis_No = "" Or Not IsNumeric(Baslangic_No) Or Not IsNumeric(Bitis_No) Then
MsgBox "Lütfen başlangıç ve bitiş numaralarını eksiksiz ve numerik değer giriniz!", vbCritical
Exit Sub
End If
If Baslangic_No > 0 And Bitis_No > 0 Then
For X = Baslangic_No To Bitis_No
S1.Range("H4") = X
S1.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:=ThisWorkbook.Path & Application.PathSeparator & "Belge " & X & ".pdf", _
Quality:=xlQualityStandard, IncludeDocProperties:=True, _
IgnorePrintAreas:=False, OpenAfterPublish:=False
Next
MsgBox "Verileriniz PDF olarak kayıt edilmiştir.", vbInformation
End If
Set S1 = Nothing
Set S2 = Nothing
Set WF = Nothing
End Sub