Merhaba,
Asagıdaki makro shared olarak calistirilamiyor. Benim bu makroya cok ihtiyacim var. Bu makronun baska bir alternatifi yada cozum yolu var mi ?
Sub Print_Click()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sheets("Groups")
Set S2 = Sheets(2)
rtarih = InputBox("Yazdırılacak Rapor Tarihini Giriniz.Örnek 06.01.2007", "UYARI")
If rtarih = "" Then Exit Sub
[Y4] = CDate(rtarih)
Set alan1 = S1.Range("a4:S100")
Set alan2 = S1.Range("Y3:Y4")
Set alan3 = S1.Range("AA4:AS100")
alan3.ClearContents
alan1.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=alan2, CopyToRange:=alan3, Unique:=True
Set S1 = Nothing
Set S2 = Nothing
Set alan1 = Nothing
Set alan2 = Nothing
Set alan3 = Nothing
ActiveSheet.PageSetup.CenterHeader = [Y4] & " Tarihli Günlük Rapor"
ActiveWindow.SelectedSheets.PrintPreview
'ActiveSheet.PrintOut Copies:=1
Application.ScreenUpdating = True
End Sub
Ilginiz icin tesekkur ederim..
Asagıdaki makro shared olarak calistirilamiyor. Benim bu makroya cok ihtiyacim var. Bu makronun baska bir alternatifi yada cozum yolu var mi ?
Sub Print_Click()
On Error Resume Next
Application.ScreenUpdating = False
Set S1 = Sheets("Groups")
Set S2 = Sheets(2)
rtarih = InputBox("Yazdırılacak Rapor Tarihini Giriniz.Örnek 06.01.2007", "UYARI")
If rtarih = "" Then Exit Sub
[Y4] = CDate(rtarih)
Set alan1 = S1.Range("a4:S100")
Set alan2 = S1.Range("Y3:Y4")
Set alan3 = S1.Range("AA4:AS100")
alan3.ClearContents
alan1.AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=alan2, CopyToRange:=alan3, Unique:=True
Set S1 = Nothing
Set S2 = Nothing
Set alan1 = Nothing
Set alan2 = Nothing
Set alan3 = Nothing
ActiveSheet.PageSetup.CenterHeader = [Y4] & " Tarihli Günlük Rapor"
ActiveWindow.SelectedSheets.PrintPreview
'ActiveSheet.PrintOut Copies:=1
Application.ScreenUpdating = True
End Sub
Ilginiz icin tesekkur ederim..