Soru Otomatik Yazıcıya yollamak

bjk55 · 19 Mart 2021

Merhaba ekte belirlediğim kırmızı alana rakam yazdığım zaman sayfada ki bilgileri formülle listeden çekiyorum. Tek sıkıntım bazen liste sayfasında çok satır olunca hepsini aynı anda bastıramıyorum "H4" sütünu durmadan değiştirip yazıcıya yollamam gerekiyor. Bunun için nasıl bir makro oluşturabilirim ki çoklu şekilde yazıcı ya da pdf olarak kaydedeyim. Yardımlarınızı bekliyorum şimdiden teşekkür ederim

Korhan Ayhan · 20 Mart 2021

Deneyiniz.

C++:

Option Explicit

Sub Seri_Yazdir()
    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.PrintOut Copies:=1
        Next
       
        MsgBox "Verileriniz yazıcıya gönderilmiştir.", vbInformation
    End If

    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
End Sub

Korhan Ayhan · 20 Mart 2021

Bu da PDF formatında çıktı alabilmenizi sağlar.

C++:

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

bjk55 · 22 Mart 2021

Çok teşekkür ederim

bjk55 · 4 Nisan 2021

Otomatik Pdf yapma

Merhaba Mutabık sayfasında Bulunan liste de ayrı ayrı firmalar var ama 28 - 35 ci (sarı) satırlar hep sabit sadece üstte filtrelediğim firmaları ben ayrı ayrı filtreden seçerek hepsini örnekteki gibi pdf yapmaktayım. Bunun için makro ile listede bulunan bütün firmalara ayrı ayrı bir butona...

www.excel.web.tr

bjk55 · 9 Mart 2022

Korhan Ayhan' Alıntı:

Bu da PDF formatında çıktı alabilmenizi sağlar.

C++:

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

Bu kodları için ayrıca jpg nasıl oluşturabilirim.

Korhan Ayhan · 13 Mart 2022

Deneyiniz.

C++:

Option Explicit

Sub Seri_Yazdir_JPG()
    Dim WF As WorksheetFunction, S1 As Worksheet
    Dim S2 As Worksheet, XL_Chart As ChartObject
    Dim Baslangic_No As Variant, Bitis_No As Variant
    Dim Alan As Range, 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
        S1.Select
        ActiveWindow.DisplayGridlines = False
       
        For X = Baslangic_No To Bitis_No
            S1.Range("H4") = X
           
            Set Alan = S1.Range("Print_Area")
           
            Alan.CopyPicture xlScreen, xlBitmap
            Set XL_Chart = S1.ChartObjects.Add(0, 0, Width:=Alan.Width, Height:=Alan.Height)
           
            With XL_Chart
                .Chart.Paste
                .Chart.Export Filename:=ThisWorkbook.Path & _
                 Application.PathSeparator & "Belge " & X & ".jpg", Filtername:="JPG"
                .Delete
            End With
        Next
      
        MsgBox "Verileriniz JPG olarak kayıt edilmiştir.", vbInformation
    End If

    Set Alan = Nothing
    Set XL_Chart = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
End Sub

tahsinanarat · 15 Mart 2022

Sn. @Korhan Ayhan hocam, Liste sayfasınan A sutununda yazılı bizim belirttiğimiz Numaraları TESLİM TESELLÜM sekmesindeki H4 hücresine yazdırarak döngüye bağlamak istersek kodda nasıl bir revize yapmamız gerekir. Teşekkürler
Liste Sayfası A sutununda
2245
2246
2300
4109
4725
vs.

Korhan Ayhan · 17 Mart 2022

Deneyiniz.

C++:

Option Explicit

Sub Seri_Yazdir()
    Dim S1 As Worksheet, S2 As Worksheet, No As Range
  
    Set S1 = Sheets("TESLİM TESELLÜM")
    Set S2 = Sheets("LİSTE")
  
    For Each No In S2.Range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row)
        If No.Value <> "" Then
            S1.Range("H4") = No.Value
            S1.PrintOut Copies:=1
        End If
    Next
      
    MsgBox "Verileriniz yazıcıya gönderilmiştir.", vbInformation

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

tahsinanarat · 17 Mart 2022

Sn. @Korhan Ayhan hocam şimdi kendi orjinal dosyama uyarlayıp denedim, tam istediğim gibi çok teşekkür ediyorum.
ilaveten, yazıcıya değil de pdf olarak kaydetmek istersek, kodda nasıl bir revize yapmalıyız. Teşekkürler.
Saygılar.

Korhan Ayhan · 17 Mart 2022

Tahsin Bey,

Bu başlıkta Yazıcı-PDF-JPG versiyonlarını içeren kodları zaten paylaştım.

Gerisini sizin halledebileceğinizi düşünüyorum.

tahsinanarat · 17 Mart 2022

Sn. @korhan Hocam , 3.mesajınızdaki kodları denedim, başlangıç ve bitiş numaralarını verdiği için arada benim istemediğim (sutunda yazılı olmayan) numaları da sırasıyla yazarak pdf yazıyor. Ben 9 nolu mesajınızdaki kodun yazıcıya değilde pdf olarak yazmasını istemiştim.

Korhan Ayhan · 17 Mart 2022

Son paylaştığım koda PDF olarak kaydetme kod bloğunu sizin ekleyebileceğinizi düşünüyorum.

tahsinanarat · 17 Mart 2022

Sn. @Korhan Ayhan hocam; tamamdır aşağıdaki kodlarla hallettim,

Kod:

Option Explicit

Sub Seri_Yazdir3()
    Dim S1 As Worksheet, S2 As Worksheet, No As range

    Set S1 = Sheets("Form_duzenle")
    Set S2 = Sheets("Eksik_Nolar")

    For Each No In S2.range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row)
        If No.Value <> "" Then
            S1.range("b11") = No.Value
            S1.ExportAsFixedFormat Type:=xlTypePDF, _
            Filename:=ThisWorkbook.Path & Application.PathSeparator & "Belge " & No.Value & ".pdf", _
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, OpenAfterPublish:=False
      End If
    Next
    
    MsgBox "Verileriniz pdf olarak kaydedilmiştir.", vbInformation

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

bjk55 · 21 Mart 2022

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Seri_Yazdir_JPG()
    Dim WF As WorksheetFunction, S1 As Worksheet
    Dim S2 As Worksheet, XL_Chart As ChartObject
    Dim Baslangic_No As Variant, Bitis_No As Variant
    Dim Alan As Range, 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
        S1.Select
        ActiveWindow.DisplayGridlines = False
      
        For X = Baslangic_No To Bitis_No
            S1.Range("H4") = X
          
            Set Alan = S1.Range("Print_Area")
          
            Alan.CopyPicture xlScreen, xlBitmap
            Set XL_Chart = S1.ChartObjects.Add(0, 0, Width:=Alan.Width, Height:=Alan.Height)
          
            With XL_Chart
                .Chart.Paste
                .Chart.Export Filename:=ThisWorkbook.Path & _
                 Application.PathSeparator & "Belge " & X & ".jpg", Filtername:="JPG"
                .Delete
            End With
        Next
     
        MsgBox "Verileriniz JPG olarak kayıt edilmiştir.", vbInformation
    End If

    Set Alan = Nothing
    Set XL_Chart = Nothing
    Set S1 = Nothing
    Set S2 = Nothing
    Set WF = Nothing
End Sub

İyi ki varsınız, teşekkür ederim

bjk55 · 4 Kasım 2022

bjk55' Alıntı:
Merhaba Mutabık sayfasında Bulunan liste de ayrı ayrı firmalar var ama 28 - 35 ci (sarı) satırlar hep sabit sadece üstte filtrelediğim firmaları ben ayrı ayrı filtreden seçerek hepsini örnekteki gibi pdf yapmaktayım. Bunun için makro ile listede bulunan bütün firmalara ayrı ayrı bir butona tıkladığım zaman otomatik pdf nasıl yapabilirim. Birde Liste çok uzun sa dikey olarak liste kısaysa yatay olarak pdf yapmak istiyorum.Dosya ektedir.

bjk55 · 24 Kasım 2022

Korhan Ayhan' Alıntı:

Deneyiniz.

C++:

Option Explicit

Sub Seri_Yazdir()
    Dim S1 As Worksheet, S2 As Worksheet, No As Range
 
    Set S1 = Sheets("TESLİM TESELLÜM")
    Set S2 = Sheets("LİSTE")
 
    For Each No In S2.Range("A2:A" & S2.Cells(Rows.Count, 1).End(3).Row)
        If No.Value <> "" Then
            S1.Range("H4") = No.Value
            S1.PrintOut Copies:=1
        End If
    Next
     
    MsgBox "Verileriniz yazıcıya gönderilmiştir.", vbInformation

    Set S1 = Nothing
    Set S2 = Nothing
End Sub

Merhaba Korhan Bey, ben bunu pdf olarak yaparken 1 den 5'e atlamasını istiyorum Bunun için ne yapabilirim

Korhan Ayhan · 24 Kasım 2022

5'ten sonra devam edecek mi? Edecekse kaç olacak?

bjk55 · 24 Kasım 2022

mesela örnek 1 den sonra 5 den sonra 9 bu şekilde gitmesi gerek

Korhan Ayhan · 24 Kasım 2022

Deneyiniz.

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

Soru Otomatik Yazıcıya yollamak

bjk55

Ekli dosyalar

Korhan Ayhan

Administrator

Korhan Ayhan

Administrator

bjk55

bjk55

Otomatik Pdf yapma

bjk55

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

Korhan Ayhan

Administrator

tahsinanarat

bjk55

bjk55

bjk55

Korhan Ayhan

Administrator

bjk55

Korhan Ayhan

Administrator