Şartlı Yazdırma Hk

ormann · 21 Nisan 2020

Merhabalar;
Veri girişi sayfasında O18 hücresinde veri yoksa sadece EBAT-1 sayfasının tamamını yazacak. Eğer O18 hücresinde veri varsa hem EBAT-1 sayfasını hemde EBAT-2 sayfasını yazacak. Ama EBAT-1 sayfasında A71:AC79 hücre içerisindeki veriyi yazmayıp sadece EBAT-2 sayfasında yazacak.

İndir EBAT LİSTESİ PROGRAMI

Dosyayı indir EBAT LİSTESİ PROGRAMI

dosya.co

ormann · 21 Nisan 2020

İyi akşamlar,
Arkadaşlar rica etsem 1.nolu mesajımda açmış olduğum konuya yardımcı olur musunuz .Saygilar

Korhan Ayhan · 21 Nisan 2020

Deneyiniz.

C++:

Option Explicit

Sub Kosullu_Yazdir()
    Dim Adet As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Veri As Range
    
    Adet = Application.InputBox("Yazdırılacak sayfa adedini giriniz.", "Sayfa Adedi Girişi", 2)
    
    If Not IsNumeric(Adet) Then
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Exit Sub
    End If
    
    If Adet = False Then
        MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        Exit Sub
    End If
    
    If Adet <= 0 Then
        MsgBox "Yazdırma işlemi için sıfırdan büyük pozitif değer giriniz!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("EBAT -1")
    Set S3 = Sheets("EBAT -2")
    
    If S1.Range("O18") = 0 Then
        With S2
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    Else
        With S2
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .Range("A71:A79").EntireRow.Hidden = True
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
        With S3
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

ormann · 22 Nisan 2020

Korhan bey yardımınız için çok teşekkür ederim.
Makro iki koşulda da EBAT-1 sayfasını yazdırıyor. Veri girişi sayfasında O18 hücresinde veri yoksa sadece EBAT-1 sayfasının tamamını yazacak. Eğer O18 hücresinde veri varsa hem EBAT-1 sayfasını hemde EBAT-2 sayfasını yazacak. Ama EBAT-1 sayfasında A71:AC79 hücre içerisindeki veriyi yazmayıp sadece EBAT-2 sayfasınıda yazacak.
NoT: Yazdırma butonuna bastığımızda Yazdırılacak sayfa adedi giriniz diye bir kutucuk açılsa .Yazdırılacak adedi girdiğimizde tamam deyince yazsa. İptal deyince vazgeçilse. Ayrıca kutucuk içerisine 2 adet hazır yazılacağı hazır gelse biz onu değiştirebilsek. Makroyu bu şekilde revize edebilir misiniz

YUSUF44 · 22 Nisan 2020

Şu kısmı Ebat 2 olarak değiştirmeniz gerekir:

Sheets("EBAT -1").PrintOut
End If

ormann · 22 Nisan 2020

Yusuf bey teşekkür ederim. EBAT1- ve EBAT-2 sayfasında AA19:AA68 hücre aralığında değeri "0" olan hücrelerin bulundukarı satırlar gizlenip ; yazdırma işlemi bittikten sonra gizlenen satırlar gösterilebilir mi? Ayrıca ,Yazdırma butonuna bastığımızda Yazdırılacak sayfa adedi giriniz diye bir kutucuk açılsa .Yazdırılacak adedi girdiğimizde tamam deyince yazsa. İptal deyince vazgeçilse. Ayrıca kutucuk içerisine 2 adet hazır yazılacağı hazır gelse biz onu değiştirebilsek. Makroyu bu şekilde revize edebilir misiniz .Buda yapılabilirse tamam olacak

Korhan Ayhan · 22 Nisan 2020

#3 nolu mesajımda ki kodu revize ettim. Tekrar deneyiniz.

Önemli Not: Taleplerinizin tümünü ilk mesajınızda belirtirseniz cevap verenler sürekli olarak konuyla ilgilenmek durumunda kalmazlar.

ormann · 22 Nisan 2020

Sayın Korhan hocam çok teşekkür ederim. Kod süper çalışıyor. Veri girişi sayfasında O18 hücresinde veri yoksa satırını O18:V18 şeklinde değiştirebilirmiyiz .Ben değiştirdim fakat

Kod:

If S1.Range("O18:v18") = 0 Then

ormann · 22 Nisan 2020

Sayın Korhan hocam çok teşekkür ederim. Kod süper çalışıyor. Veri girişi sayfasında O18 hücresinde veri yoksa satırını O18:V18 şeklinde değiştirebilirmiyiz .Ben değiştirdim fakat kod hata verdi.

Kod:

If S1.Range("O18:v18") = 0 Then

Korhan Ayhan · 22 Nisan 2020

Bu aralıktaki değerler hep pozitif oluyorsa aşağıdaki gibi olabilir.

C++:

If WorksheetFunction.Sum(S1.Range("O18:v18")) = 0 Then

ormann · 22 Nisan 2020

Korhan bey çok teşekkür ederim.Kodlar tam istediğim gibi.Ellerinize sağlik

ormann · 1 Haziran 2020

Korhan bey hocam iyi akşamlar;
Aşağıda yazdırma ile ilgili yapmış olduğunuz kodu, yazdırma ile ilgili değilde ön izleme için yapa bilir misiniz.

Kod:

Option Explicit

Sub Kosullu_Yazdir()
    Dim Adet As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Veri As Range
    
    Adet = Application.InputBox("Yazdırılacak sayfa adedini giriniz.", "Sayfa Adedi Girişi", 2)
    
    If Not IsNumeric(Adet) Then
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Exit Sub
    End If
    
    If Adet = False Then
        MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        Exit Sub
    End If
    
    If Adet <= 0 Then
        MsgBox "Yazdırma işlemi için sıfırdan büyük pozitif değer giriniz!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("EBAT -1")
    Set S3 = Sheets("EBAT -2")
    
    If S1.Range("O18") = 0 Then
        With S2
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    Else
        With S2
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .Range("A71:A79").EntireRow.Hidden = True
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
        With S3
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

Korhan Ayhan · 1 Haziran 2020

Önizleme de ki durumda yazdırma işleminde mantıkla olacaksa kod içindeki aşağıdaki satırları;

.PrintOut Copies:=Adet

Bir alttaki kod ile değiştirip deneyiniz.

.PrintPreview

ormann · 2 Haziran 2020

Korhan bey çok teşekkür ederim

ormann · 10 Temmuz 2020

Korhan bey hocam merhabalar;
Ekli dosyamda veri girişi sayfasındaki yazdır butonu ile şartlı olarak aşağıdaki makro ile Ebat-1 ve Ebat-2 sayfalarını yazdırabiliyoruz. Yazdır Butonuna bastığımız da 3 sayfa yazdırıyoruz. Acaba yazdır butonuna bastığımızda 1. Çıktıya
veri girişi sayfasındaki F9 Hücresindeki veriyi Ebat-1 sayfasında J12 hücresine
veri girişi sayfasındaki F10 Hücresindeki veriyi Ebat-1 sayfasında J11 hücresindeki verileri yazdırabilir miyiz .Not:2 ve 3. çıktılar da veriler yazılmayacak.

Dosya Link:

İndir EBAT SON xlsm

Dosyayı indir EBAT SON xlsm

dosya.co

Kod:

Sub Kosullu_Yazdir()
    Beep
    Sheets("EBAT -1").Unprotect 123
    Sheets("EBAT -2").Unprotect 123
    Dim Adet As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Veri As Range
    If Sheets("VERİ GİRİŞİ").Range("J4") = Empty Then MsgBox "LÜTFEN İŞLETME MÜDÜRLÜĞÜNÜ SEÇİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J4").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J5") = Empty Then MsgBox "LÜTFEN İŞLETME ŞEFLİĞİNİ SEÇİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J5").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J6") = Empty Then MsgBox "LÜTFEN İSTİF YERİNİ GİRİNİZ?": Sheets("VERİ GİRİŞİ").Range("J6").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J7") = Empty Then MsgBox "LÜTFEN İSTİF TARİHİNİ GİRİNİZ?": Sheets("VERİ GİRİŞİ").Range("J7").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J8") = Empty Then MsgBox "LÜTFEN İSTİF NUMARASININ GİRİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J8").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J10") = Empty Then MsgBox "LÜTFEN EMVALİN CİNS VE NEVİNİ GİRİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J10").Select: Exit Sub
    
    
    Adet = Application.InputBox("Yazdırılacak sayfa adedini giriniz.", "Sayfa Adedi Girişi", 3)
    
    If Not IsNumeric(Adet) Then
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Exit Sub
    End If
    
    If Adet = False Then
        MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        Exit Sub
    End If
    
    If Adet <= 0 Then
        MsgBox "Yazdırma işlemi için sıfırdan büyük pozitif değer giriniz!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("EBAT -1")
    Set S3 = Sheets("EBAT -2")
    
    If WorksheetFunction.Sum(S1.Range("O18:v18")) = 0 Then
        With S2
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    Else
        With S2
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .Range("A71:A79").EntireRow.Hidden = True
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
        With S3
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    Application.ScreenUpdating = True
    
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
 Sheets("EBAT -1").Protect 123
 Sheets("EBAT -2").Protect 123
End Sub

Korhan Ayhan · 11 Temmuz 2020

1. Çıktı'dan kastınız nedir?

ormann · 11 Temmuz 2020

Korhan bey merhabalar,
Yazdır butonuna bastığımızda bize kutucuk açılıyor.Kutucuğun içerisinde sayfa adedi 3 yazıyor.Yazdır dediğimde aynı sayfadan 3 adet yazdırıyor.Benim istediğim , 1. Adette çıktıda belirttiğim hücrelerdeki veriler yazılacak.Diğer çıktılarda belirttiğim hücrelerdeki veriler gözükmeyecek

Korhan Ayhan · 11 Temmuz 2020

Adet kutusuna 1 yazma durumu var mı? Varsa bu durumda işlem nasıl olacak?

Ek olarak hücre adreslerinde bir sıkıntı yok değil mi? İlgili hücrelerde aşağıdakiler yazıyor.

VERİ GİRİŞİ F9 = PARTİ NO
VERİ GİRİŞİ F10 = CİNS NEVİ-SINIF

Ayrıca EBAT-1 sayfasında J11 ve J12 hücreleri birleştirilmiş hücre görünüyor. Bu sebeple adresler hatalı olmuş oluyor.

Bu hücreler aslında F11 ve F12 hücreleri oluyor.

ormann · 11 Temmuz 2020

Adet kutusuna 1 yazma durumu var . 1 yazdığımızda aşağıda ki verileri yazmayacak .Adet kutusuna 1 den fazla yazdığım zaman 1.çıktıya yazacak. Diğerlerinde gözükmeyecek
Veri Girişi J11 hücresindeki veriyi Ebat-1 sayfasında F10 hücresine yazacak
Veri Girişi J12 hücresindeki veriyi Ebat-1 sayfasında F9 hücresine yazacak.

Korhan Ayhan · 11 Temmuz 2020

Deneyiniz.

C++:

Sub Kosullu_Yazdir()
    Beep
    Sheets("EBAT -1").Unprotect 123
    Sheets("EBAT -2").Unprotect 123
    Dim Adet As Variant, S1 As Worksheet, S2 As Worksheet, S3 As Worksheet, Veri As Range
    If Sheets("VERİ GİRİŞİ").Range("J4") = Empty Then MsgBox "LÜTFEN İŞLETME MÜDÜRLÜĞÜNÜ SEÇİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J4").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J5") = Empty Then MsgBox "LÜTFEN İŞLETME ŞEFLİĞİNİ SEÇİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J5").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J6") = Empty Then MsgBox "LÜTFEN İSTİF YERİNİ GİRİNİZ?": Sheets("VERİ GİRİŞİ").Range("J6").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J7") = Empty Then MsgBox "LÜTFEN İSTİF TARİHİNİ GİRİNİZ?": Sheets("VERİ GİRİŞİ").Range("J7").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J8") = Empty Then MsgBox "LÜTFEN İSTİF NUMARASININ GİRİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J8").Select: Exit Sub
    If Sheets("VERİ GİRİŞİ").Range("J10") = Empty Then MsgBox "LÜTFEN EMVALİN CİNS VE NEVİNİ GİRİNİZ ?": Sheets("VERİ GİRİŞİ").Range("J10").Select: Exit Sub
    
    
    Adet = Application.InputBox("Yazdırılacak sayfa adedini giriniz.", "Sayfa Adedi Girişi", 3)
    
    If Not IsNumeric(Adet) Then
        MsgBox "Lütfen sayısal değer giriniz!", vbCritical
        Exit Sub
    End If
    
    If Adet = False Then
        MsgBox "Yazdırma işlemi iptal edilmiştir!", vbCritical
        Exit Sub
    End If
    
    If Adet <= 0 Then
        MsgBox "Yazdırma işlemi için sıfırdan büyük pozitif değer giriniz!", vbCritical
        Exit Sub
    End If
    
    Application.ScreenUpdating = False
    
    Set S1 = Sheets("VERİ GİRİŞİ")
    Set S2 = Sheets("EBAT -1")
    Set S3 = Sheets("EBAT -2")
    
    If WorksheetFunction.Sum(S1.Range("O18:v18")) = 0 Then
        With S2
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            If Adet > 1 Then
                S2.Range("F10") = S1.Range("J11")
                S2.Range("F9") = S1.Range("J12")
                .PrintOut Copies:=1
                S2.Range("F12") = ""
                S2.Range("F11") = ""
                .PrintOut Copies:=Adet - 1
            Else
                S2.Range("F12") = ""
                S2.Range("F11") = ""
                .PrintOut Copies:=Adet
            End If
            .Cells.EntireRow.Hidden = False
        End With
    Else
        With S2
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .Range("A71:A79").EntireRow.Hidden = True
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
        With S3
            .Cells.EntireRow.Hidden = False
            For Each Veri In .Range("AA19:AA68")
                If Veri.Value = 0 Then Veri.EntireRow.Hidden = True
            Next
            .PrintOut Copies:=Adet
            .Cells.EntireRow.Hidden = False
        End With
    End If
    
    Set S1 = Nothing
    Set S2 = Nothing
    Set S3 = Nothing
    
    Sheets("EBAT -1").Protect 123
    Sheets("EBAT -2").Protect 123
    
    Application.ScreenUpdating = True
    
    MsgBox "Yazdırma işlemi tamamlanmıştır.", vbInformation
End Sub

Şartlı Yazdırma Hk

ormann

İndir EBAT LİSTESİ PROGRAMI

ormann

Korhan Ayhan

Administrator

ormann

YUSUF44

Destek Ekibi

ormann

Korhan Ayhan

Administrator

ormann

ormann

Korhan Ayhan

Administrator

ormann

ormann

Korhan Ayhan

Administrator

ormann

ormann

İndir EBAT SON xlsm

Korhan Ayhan

Administrator

ormann

Korhan Ayhan

Administrator

ormann

Korhan Ayhan

Administrator