İki kodu birleştirmede yardım

[Ergün GÖKER]

Herkese hayırlı akşamlar
Elimde yazdırmayla ilgili iki kod var bu kodları birleştirmek ve şu şekilde yapmasını istiyorum
Yazdır Butonuna bastığımda kaç adet yazdıracağını soracak örneğin 2 seçili tamam dediğimde sayfa yapısı ne yüzdedeyse onu ayarlayıp sayfayı sığdırıp yazdıracak

Private Sub CommandButton4_Click()

    Adet = Application.InputBox("Kaç adet çıktı almak istiyor sunuz?", , 2)
    If Adet = False Then
        MsgBox "İşlemi iptal ettiniz!", vbInformation
    Else
        If Adet <> "" And Adet > 0 Then Sheets("EK2A").PrintOut Copies:=Adet
    End If

End Sub




Private Sub CommandButton4_Click() 'YAZDIR
Son = [B65536].End(3).Row
If Son < 62 Then
  ActiveSheet.PageSetup.PrintArea = "$B$6:$S$" & Son
    With ActiveSheet.PageSetup
        .Zoom = False
    End With
  ActiveSheet.PrintOut
Else
  ActiveSheet.PageSetup.PrintArea = "$B$6:$S$48"
    With ActiveSheet.PageSetup
        .Zoom = 70
    End With
  ActiveSheet.PrintOut
End If
MsgBox "YAZDIRMA İŞLEMİ TAMAMLANMIŞTIR.  LÜTFEN YAZICI ÇIKTISINI KONTROL EDİNİZ.! ", vbInformation, " XXXXXXXXXX   &   XXXXXXXXXXXXX  "
End Sub

 

[PLİNT]

Merhaba
Yazdırılacak sayfa "EK2A" ise aşağıdaki gibi deneyin,
yüzdesi otomatik ayarlanacaktır

Private Sub CommandButton4_Click()
Dim Adet As String
Dim Son As Long
Adet = Application.InputBox("Kaç adet çıktı almak istiyor sunuz?", , 2)
If IsNumeric(Adet) = False Then GoTo 10
If Adet = 0 Then
10:
MsgBox "İşlemi iptal ettiniz!", vbInformation
Exit Sub
End If
Son = Sheets("EK2A").[B65536].End(3).Row
If Son < 62 Then
  Sheets("EK2A").PageSetup.PrintArea = "$B$6:$S$" & Son
    With Sheets("EK2A").PageSetup
        .Zoom = False
         .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
 Sheets("EK2A").PrintOut Copies:=Adet
Else
Sheets("EK2A").PageSetup.PrintArea = "$B$6:$S$48"
    With Sheets("EK2A").PageSetup
        .Zoom = False
         .FitToPagesWide = 1
        .FitToPagesTall = 1
    End With
 Sheets("EK2A").PrintOut Copies:=Adet
End If
MsgBox "YAZDIRMA İŞLEMİ TAMAMLANMIŞTIR.  LÜTFEN YAZICI ÇIKTISINI KONTROL EDİNİZ.! ", vbInformation, " XXXXXXXXXX   &   XXXXXXXXXXXXX  "
End Sub

 

[Ergün GÖKER]

Hocam teşekkür ederim saygılar sunarım. Hocam Kodu denedim güzel yalnız yazdır dedikten sonra sayfa sayısını giriyorum, yazdırmaktan vazgeçtiğimde hata mesajı alıyorum. kod do düzeltme yapabilirmisiniz. Saygılarımla
Hocam Yazdırmayı iptal ettiğimizde de Yazdırmayı iptal ettiniz gibi bir uyarı vermesini istiyorum. Şimdiden Teşekkürler

 

[PLİNT]

Merhaba
Yukarıdaki değişen şekliyle deneyelim

 

[Ergün GÖKER]

Merhaba
Yukarıdaki değişen şekliyle deneyelim

Hocam teşekkür ederim saygılar sunarım. Kolay gelsin