Yazıcıdan çıktı alma

[power468]

Merhaba aşağıdaki kodlarla belirlediğim hücrelere göre çıktı alıyorum. ben butona basınca sadece dolu sayfaları yazdırmak istiyorum yardımcı olursanız sevinirim.





Private Sub CommandButton21_Click()
If Application.Visible = False Then
Application.Visible = True
CommandButton21.Caption = "Exceli Gizle"
ElseIf Application.Visible = True Then
Application.Visible = False
CommandButton21.Caption = "Exceli Göster"
End If

ActiveWorkbook.Worksheets("FAALİYET RAPORU").Select

Worksheets("FAALİYET RAPORU").Activate
Sheets("FAALİYET RAPORU").PageSetup.PrintArea = "A1. A24 : I1. I24"
ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

 

[pitchoute]

Bu şekilde deneyip sonucu paylaşabilir misiniz;

Private Sub CommandButton21_Click()
    If Application.Visible = False Then
        Application.Visible = True
        CommandButton21.Caption = "Exceli Gizle"
    Else
        Application.Visible = False
        CommandButton21.Caption = "Exceli Göster"
    End If

    Dim ws As Worksheet
    Set ws = ThisWorkbook.Worksheets("FAALİYET RAPORU")

    Dim rng As Range
    Set rng = ws.Range("A1:I24")

    ' Hücre aralığında herhangi bir veri olup olmadığını kontrol edin
    If Application.WorksheetFunction.CountA(rng) > 0 Then
        ws.PageSetup.PrintArea = "A1:I24"
        ws.PrintOut Copies:=1
    Else
        MsgBox "Belirtilen alanda yazdırılacak veri yok.", vbInformation, "Yazdırma"
    End If
End Sub

 

[hamitcan]

    x = WorksheetFunction.CountA([a1:a24])
    y = WorksheetFunction.CountA([i1:i24])
    If x > 0 Then
Sheets(1).PageSetup.PrintArea = "A1:A24"
    End If
    If y > 0 Then
Sheets(1).PageSetup.PrintArea = "I1:I24"
    End If
    If x > 0 And y > 0 Then
Sheets(1).PageSetup.PrintArea = "A1:A24,I1:I24"
    End If

böyle deneyin.