• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Macro çalıştığında ilgili sayfa bilgisayara kaydedilsin(Çıktının kopyası gibi)

Katılım
14 Mart 2008
Mesajlar
119
Excel Vers. ve Dili
XP TR
Merhabalar
Benim yaptığım bir program var. Bu programda bir düğmeye basınca yazıcıdan başka bir sayfanın çıktısını alabiliyorum. Benim istediğim şey ise bu yazdırma düğmesine tıkladığımda yazdırmaya ek olarak yazdırılan sayfanın bir kopyasını da jpg,jpeg,pdf,xls,doc vs bir şekilde bilgisayarda benim belirleyeceğim bir klasöre kaydetsin istiyorum. Bu mümkün müdür ?
Dosya ektedir
 

Ekli dosyalar

Merhabalar
Benim yaptığım bir program var. Bu programda bir düğmeye basınca yazıcıdan başka bir sayfanın çıktısını alabiliyorum. Benim istediğim şey ise bu yazdırma düğmesine tıkladığımda yazdırmaya ek olarak yazdırılan sayfanın bir kopyasını da jpg,jpeg,pdf,xls,doc vs bir şekilde bilgisayarda benim belirleyeceğim bir klasöre kaydetsin istiyorum. Bu mümkün müdür ?
Dosya ektedir

bunu denermisiniz

Sub yedekkal()
deger = InputBox("Sayfanın adını değiştirebilirsiniz.", "UYARI!", ActiveSheet.Name)
'dosya_adı = ActiveWorkbook.Name
Sayfa_adı = ActiveSheet.Name
On Error Resume Next
Dim Baslik As String
Baslik = "Kaynak Dosyaları İçeren Klasörü Seçin"
Set Obj = CreateObject("shell.application")
Set Klasor = Obj.BrowseForFolder(0, Baslik, 50, &H0)
Kaynak = Klasor.items.Item.Path
If Len(Kaynak) = 3 Then
Kaynak = Mid(Kaynak, 1, 2)
Else
Kaynak = Kaynak
End If
If Not Klasor Is Nothing Then
If InStr(1, Kaynak, "{") > 0 Then GoTo Atla
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = deger
ActiveWorkbook.SaveAs Kaynak & "\" & deger & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
Else
Atla:
MsgBox "Lütfen Kaynak Klasör Seçimini Yapınız !", vbInformation, "DİKKAT"
End If
End Sub
 
Çok teşekkürler çalışmanız için yalnız birkaç noktada değişiklik gerekiyor;
Ben istiyorum ki yazdırma düğmesinin bulunduğu sayfanın değil başka bir sayfanın yedeğini alsın istiyorum.
Kullanıcının istediği bir isimle değil de dosya adı standart olsun. Örneğin FirmaAdı_SiparişNo.xls olsun
Kullanıcının istediği bir klasöre değil de direkt benim belirteceğim bir klasöre yedek alsın istiyorum
Son olarak;Kaydederken Macro içeren bir dosya olarak kaydetmek isteyip istemediğimi soruyor. Bunu sormadan direkt olarak kaydetsin istiyorum. Macro içeren veya içermeyen.

Çok teşekkür ediyorum
 
bunu denermiainiz.

Sub yedekkal()
dosya_adı = "FirmaAdı_SiparişNo" 'dosya adını buraya yazınız.
Sayfa_adı = "Sayfa2" 'sayfa adını buraya yazınız.
kayıt_yeri = "D:\" 'Kayıt yapılacak yer
On Error Resume Next
Dim sayfa As Worksheet
For Each sayfa In Worksheets
MsgBox Worksheets
If sayfa.Name = Sayfa_adı Then
sayfa.Copy
Sheets(ActiveSheet.Name).Name = Sayfa_adı
ActiveWorkbook.SaveAs kayıt_yeri & dosya_adı & ".xls"
ActiveWorkbook.Close False
Exit Sub
End If
Next sayfa
End Sub
 
Geri
Üst