Print edilen sayfanın otomatik kaydedilmesi

[themaniac]

Arkadaşlar merhaba,

Ben bir excel sheet içerisinde ayarladığım bir yazdırma alanı var. Sürekli olarak bunu doldurup direk çıktısını alıyorum.
Ama bu dosyaların sonradan kaybolma ihtimaline karşın, ben Ctrl+P yaptığımda o sayfayı yazdırırken aynı anda daha önceden belirlenmiş bir klasöre otomatik olarak bu sayfayı PDF yada başka bir formatta kaydetsin istiyorum.

Bu mümkün müdür?

 

[hamitcan]

Böyle deneyin.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    sb_Copy_Save_Worksheet_As_Workbook
End Sub

Sub sb_Copy_Save_Worksheet_As_Workbook()
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ActiveSheet.PrintPreview
    ThisWorkbook.Sheets("Sayfa1").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\" & Replace(Replace(Now, "/", "."), ":", ".") & ".xlsx"
End Sub

Kaynak: http://analysistabs.com/vba/save-sheet-as-workbook-excel-macro-code/

 

[themaniac]

Peki bunu nereye nasıl ekliyoruz

Üç beş formülasyon yazmışlığım var hepsi bu. Çok excel'den anlamam açıkçası.

Böyle deneyin.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    sb_Copy_Save_Worksheet_As_Workbook
End Sub

Sub sb_Copy_Save_Worksheet_As_Workbook()
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ActiveSheet.PrintPreview
    ThisWorkbook.Sheets("Sayfa1").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\" & Replace(Replace(Now, "/", "."), ":", ".") & ".xlsx"
End Sub

Kaynak: http://analysistabs.com/vba/save-sheet-as-workbook-excel-macro-code/

 

[hamitcan]

1-Alt+F11 tuşlarına basın
2-ThisWorkBook kısmına verdiğim kodu ekleyin.

 

[themaniac]

1-Alt+F11 tuşlarına basın
2-ThisWorkBook kısmına verdiğim kodu ekleyin.

Dediğiniz gibi yaptım ama olmadı.

Kodu aşağıdaki gibi düzenledim ve klasörü belirttim:

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    sb_Copy_Save_Worksheet_As_Workbook
End Sub

Sub sb_Copy_Save_Worksheet_As_Workbook()
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ActiveSheet.PrintPreview
    ThisWorkbook.Sheets("Sayfa1").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\Users\Admin\Desktop\OdemeTalepleri" & Replace(Replace(Now, "/", "."), ":", ".") & ".xlsx"
End Sub

ThisWorkBook kısmına direk bu kodu yapıştırdım. Sonrada print ettim bir kaç kez ama hiç birinde kaydetmedi dosyayı.

 

[themaniac]

Ayrıca benim bu dökümanlarımı kimin adına çıkardığım C8 hücresinde yazıyor. dosyanın adını da C8'den alıp yanına da o anın tarihini atması mümkün müdür?

 

[themaniac]

Kaydetti. En son bir buton ekledim ve kod ile butonu birleştirdim. Çalıştı. Ancak şöyle bir durum var şuan.
Bu isim meselesi. Direk tarih ve saat yazıyor.
Ben bunun başına da C8 hücresinde yer alan bilgi + tarih saat olsun istiyorum.
Bunu nasıl ekleyebiliriz??

 

[hamitcan]

İlgili satırı aşağıdaki ile değiştirin.

wb.SaveAs "C:\Users\Admin\Desktop\OdemeTalepleri" & [COLOR=RED][C8][/COLOR] & Replace(Replace(Now, "/", "."), ":", ".") & ".xlsx"
End Sub

 

[themaniac]

Bunu ekledim ilgili yere ve artık Error veriyor.
Error görüntüsü ekte.

Birde error'a END deyince Excel hata veriyor duruyor ve tekrar başlatılıyor.

:yardim:

 

[hamitcan]

Bu şekilde dener misiniz ? Dosya yolunu "C:\" dizini olarak belirledim eğer kod çalışırsa yolu istediğiniz biçimde değiştirebilirsiniz.

Private Sub Workbook_BeforePrint(Cancel As Boolean)
    sb_Copy_Save_Worksheet_As_Workbook
End Sub

Sub sb_Copy_Save_Worksheet_As_Workbook()
    Dim wb As Workbook
    Set wb = Workbooks.Add
    ActiveSheet.PrintPreview
    ThisWorkbook.Sheets("Sayfa1").Copy Before:=wb.Sheets(1)
    wb.SaveAs "C:\" & [c8] & " " & Replace(Replace(Now, "/", "."), ":", ".") & ".xlsx"
End Sub