Makbuz hazırlama ve kayıt etme

[istanbulcahan]

Dernekler üye aidatlarını ve bağışlarını Makbuzla (alındı belgesi) ile yapmaktadır. Formda bazı makbuz örnekleri var. Ama tam anlamıyla uymadı. Basit bir örnek excel dosyası hazırladım.
Düşeyara ve Makro için örneklerden faydalanmaya çalıştım olmadı. benim makro ve kod bilgim çok az yapamadım. Yardımcı olabilecek var mı.
Kaydet makrosu :

Sub Kaydet()
Dim wb As Workbook
Application.DisplayAlerts = False
For Each wb In Application.Workbooks
wb.Save
Next wb
Application.DisplayAlerts = True
End Sub

Pdf olarak kaydet makrosu

Yazdır makrosu

Sub yazdır1()


ReDim yön(14)
ReDim yaz(14)

yön(1) = xlPortrait 'dikey
yön(2) = xlPortrait 'dikey
yön(3) = xlPortrait 'dikey
yön(4) = xlPortrait 'dikey
yön(5) = xlPortrait 'dikey
yön(6) = xlLandscape 'yatay
yön(7) = xlLandscape 'yatay
yön(8) = xlPortrait 'dikey
yön(9) = xlPortrait 'dikey
yön(10) = xlPortrait 'dikey
yön(11) = xlPortrait 'dikey
yön(12) = xlLandscape 'yatay
yön(13) = xlPortrait 'dikey
yön(14) = xlPortrait 'dikey


yaz(1) = "$A$1:$C$51"
yaz(2) = "$M$3:$V$72"
yaz(3) = "$M$74:$V$143"
yaz(4) = "$Z$3:$AK$64"
yaz(5) = "$AO$2:$BJ$55"
yaz(6) = "$BN$3:$CU$50"
yaz(7) = "$CY$2:$DT$49"
yaz(8) = "$DX$4:$EK$39"
yaz(9) = "$DX$59:$EK$93"
yaz(10) = "$DX$100:$EK$130"
yaz(11) = "$DX$138:$EK$166"
yaz(12) = "$BO$4:$FD$49"
yaz(13) = "$FH$3:$FK$57"
yaz(14) = "$FV$3:$FY$57"


adet = Application.InputBox("Yazdırmak İstiyormusunuz.", "Yazdırılacak kadar sayı giriniz.", "1", 400, 30, , Type:=1)
    
If adet = False Then
MsgBox "İşlemi iptal ettiniz"
Exit Sub
End If


ActiveSheet.PageSetup.Zoom = False
For i = 1 To 14
Worksheets(ActiveSheet.Name).PageSetup.Orientation = yön(i)
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = yaz(i)
ActiveWindow.SelectedSheets.PrintPreview
Worksheets(ActiveSheet.Name).PrintOut Copies:=adet, Collate:=True
Next i
Worksheets(ActiveSheet.Name).PageSetup.PrintArea = ""

MsgBox ("işlem tamam."), vbInformation, "UYARI"

End Sub

Yapılabilirse çok işe yarar.