Skip to main content

AccessTr.neT


Yazdırma Mantığını Yazıcıya Değil Pdf Olarak Ayrı Ayrı Yazdırılabilir Mi?

Yazdırma Mantığını Yazıcıya Değil Pdf Olarak Ayrı Ayrı Yazdırılabilir Mi?

#7
Sayın yyhy ekteki örnek  bilmiyorum istediğinize uygun mu? İnceler misiniz?
.rar PDF Yazdırma Deneme_userx.rar (Dosya Boyutu: 29,89 KB | İndirme Sayısı: 6)
"Dünyayı fazla düşünme."
Cevapla
#8
Ben dosya adını yani yazdırdığım her dosya adı için Örneğin A1 hücresini referans alarak ( indis ile oraya numarayı getirteceğim-düşürteceğim) o sayfanın adını o hücreden alarak kaydetsin,

Kayıt yeri olarak da D sürücüsü içerisinde Daimi Arama klasörü içerisine kayıt etmesini,

Alternatif olarak da 1 ile 500 arası dijital çıktıyı tek tek kayıt yerine dosya adı önemli değil tek dosya olarak da alternatif makro ile bir tuşa bağlayıp yazdırmak istiyorum, kayıt yeri yine D sürücüsü olsun. Daimi Arama 2 klasörü olabilir.
Cevapla
#9
dilerim işinize yarar
tek tek pdf kodu:
Baslik$ = "Yazdır."
Mesaj$ = "Belirlenen sayıya kadar yazdırılacak, Onaylıyormusunuz?"
cevap$ = MsgBox(Mesaj$, 4 + 32 + 0, Baslik$)
If cevap$ = 6 Then
Dim ilk As Integer
Dim son As Integer
Dim S1 As Worksheet
Dim S2 As Worksheet
Set S1 = Sheets("Sorgu")
Set S2 = Sheets("2")

ilk = S1.Range("E11").Value
son = S1.Range("J11").Value
For i = ilk To son
S1.Range("E3").Value = i
S2.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & i & "_hy.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:= _
        False 'S2.PrintOut Copies:=1, Collate:=True
Next
MsgBox "Yazdırma İşlemi Gerçekleştirildi.", vbInformation, "Hazırlayan; Adli Büro "
End If

Set S1 = Nothing
Set S2 = Nothing
Toplu Pdf Kodu:
Baslik$ = "Yazdır."
Mesaj$ = "Belirlenen sayıya kadar yazdırılacak, Onaylıyormusunuz?"
cevap$ = MsgBox(Mesaj$, 4 + 32 + 0, Baslik$)
If cevap$ = 6 Then
Dim ilk As Integer
Dim son As Integer
Dim SonStr As Long
Dim S1 As Worksheet
Dim S2 As Worksheet
Dim TmpSHdf As Worksheet

Set S1 = Sheets("Sorgu")
Set S2 = Sheets("2")
'hy______________________________________
Application.ScreenUpdating = False
On Error GoTo ErrorHandler:

ThisWorkbook.Worksheets.Add.Name = "TmpSHdf"
Set TmpSHdf = Sheets("TmpSHdf")
ilk = S1.Range("E11").Value
son = S1.Range("J11").Value
SonStr = 0

For i = ilk To son
S1.Range("E3").Value = i
S2.Range("B1:J50").Copy
TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteFormats
TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteValuesAndNumberFormats
SonStr = SonStr + 1
Next
S2.Range("B1:J50").Copy
TmpSHdf.Range("A" & SonStr * 50 + 1).PasteSpecial xlPasteColumnWidths


TmpSHdf.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        ActiveWorkbook.Path & "\" & ilk & "_" & son & "_Arası.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=True, OpenAfterPublish:= _
        False 'S2.PrintOut Copies:=1, Collate:=True

Application.DisplayAlerts = False
TmpSHdf.Delete
Application.DisplayAlerts = True

ErrorHandler:
Application.ScreenUpdating = True

'hy______________________________________
MsgBox "Yazdırma İşlemi Gerçekleştirildi.", vbInformation, "Hazırlayan; Adli Büro "
End If

Set S1 = Nothing
Set S2 = Nothing
Set TmpSHdf = Nothing
.rar PdfYapExcel_2_hy.rar (Dosya Boyutu: 34,62 KB | İndirme Sayısı: 11)
Cevapla
#10
Kodları inceleyip dönüş yapacağım.
Cevapla
#11
Filename:= _
ActiveWorkbook.Path & "\" & ilk & "_" & son & "_Arası.pdf" burası dosya adresi ve adının olduğu yerdir
oraya istediğinizi yazarsınız
Filename:= _
DosyaAdresi & "\" & dosyaAdı & ".pdf"
Cevapla
#12
Toplu güzel olmuş yalnız dosya kayıt yeri D:\Daimi Arama01 Klasörüne kayıt yapsa daha güzel olacak.
Tek tek de güzel olmuş ama kayıt yeri D:\Daimi Arama02 Klasörüne kayıt yapsa ayrıca yazdırdığı sayfada B2 hücresindeki adı dosya adı olarak kaydederse süper olacak.
Cevapla

Bir hesap oluşturun veya yorum yapmak için giriş yapın

Yorum yapmak için üye olmanız gerekiyor

ya da
Task