yıl sonu geldiğinde ilgili sayfanın arşivini alma işlemi

[excel_ance]

arkadaşlar Milli Eğitim Bakanlığında çalışan işçiler için bir maaş programı yapıyorum fakat yıl sonu geldiğinde arşiv sayfasının ilgili yıla göre pdf belgesi olarak arşiv almasını istiyorum. yardımcı olursanız sevinirim. Teşekkürler

 

[halit3]

arkadaşlar Milli Eğitim Bakanlığında çalışan işçiler için bir maaş programı yapıyorum fakat yıl sonu geldiğinde arşiv sayfasının ilgili yıla göre pdf belgesi olarak arşiv almasını istiyorum. yardımcı olursanız sevinirim. Teşekkürler

kod:

Sub yedek()
Klasor = "C:\Yedek"
On Error Resume Next
If Dir(Klasor) = "" Then MkDir Klasor

'On Error Resume Next
Set Sh = Sheets("ARŞİV")
If WorksheetFunction.CountA(Sh.Cells) > 0 Then
sat = Sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dosya_Adı = Format(Now, "dd_mm_yyyy_hh_mm_ss")
Sh.Range(Cells(1, 1), Cells(sat, sut)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Klasor & Application.PathSeparator & Dosya_Adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Yedekleme işlemi tamamlanmıştır.", vbInformation
End If

End Sub

Bu kod ofis2007 nin alversiyonlarında çalışmaz.

 

[excel_ance]

çok teşekkürler

kod:

Sub yedek()
Klasor = "C:\Yedek"
On Error Resume Next
If Dir(Klasor) = "" Then MkDir Klasor

'On Error Resume Next
Set Sh = Sheets("ARŞİV")
If WorksheetFunction.CountA(Sh.Cells) > 0 Then
sat = Sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row
sut = Sh.Cells.Find(What:="*", After:=[A1], SearchOrder:=xlByColumns, SearchDirection:=xlPrevious).Column
Dosya_Adı = Format(Now, "dd_mm_yyyy_hh_mm_ss")
Sh.Range(Cells(1, 1), Cells(sat, sut)).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Klasor & Application.PathSeparator & Dosya_Adı, Quality:=xlQualityStandard, _
IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
MsgBox "Yedekleme işlemi tamamlanmıştır.", vbInformation
End If

End Sub

Bu kod ofis2007 nin alversiyonlarında çalışmaz.

halit bey. elinize, emeğinize yüreğinize sağlık. çok işime yaradı "hocam yedek klasörünü oluşturuyor ancak yedek alma işlemi olmuyor.

 

[excel_ance]

Halit hocam denemek için tarihi yıl sonuna aldım yedek alındı dedi, C'nin içinde yedek klasörünü açmış ancak içi boş sadece dosyayı oluşturuyor yılsonu arşivini oluşturmuyor. saygılarımla