Kayıt ve Yedekleme Kodlarım

[webuzmani]

Sub auto_open()

Application.OnTime Now + TimeValue("01:00:00"), "Yedek"
Application.OnTime Now + TimeValue("02:00:00"), "Kayıt"

End Sub
Sub Yedek()
Dim kopyaal As String, kopyayolla As String, dosyam As String
dosyam = ActiveWorkbook.Name
kopyaal = ActiveWorkbook.FullName
kopyayolla = "d:\" & dosyam
ActiveWorkbook.SaveCopyAs kopyayolla
kopyaal = vbNullString
dosyam = vbNullString
kopyayolla = vbNullString
AyarZaman = Now + TimeSerial(1, 0, 0)
Application.OnTime AyarZaman, "Yedek"


End Sub

Sub Kayıt()

For Each xyz In Application.Workbooks

xyz.Save

Next xyz

Call auto_open

End Sub

Eklenti dosyam bütün açık dosyalarda kayıt işlemini yapıyor. sadece aktif dosyada yedek alıyor. bütün dosyaların yedek almasını da istiyorum. kodlarımda nasıl bir değişiklik yapmam gerekiyor.

 

[PLİNT]

Merhaba
Kodlarınızdaki "Sub Yedek" makrosu nu aşağıdaki gibi değiştirip deneyin.

Sub Yedek()
Dim kopyaal As String, kopyayolla As String, dosyam As String
For Each a In Application.Workbooks

dosyam = a.Name
      'kopyaal = ActiveWorkbook.FullName
kopyayolla = "d:\" & dosyam
a.SaveCopyAs kopyayolla
Next
      'kopyaal = vbNullString
dosyam = vbNullString
kopyayolla = vbNullString
AyarZaman = Now + TimeSerial(1, 0, 0)
Application.OnTime AyarZaman, "Yedek"
End Sub

 

[webuzmani]

Merhaba
Kodlarınızdaki "Sub Yedek" makrosu nu aşağıdaki gibi değiştirip deneyin.

Sub Yedek()
Dim kopyaal As String, kopyayolla As String, dosyam As String
For Each a In Application.Workbooks

dosyam = a.Name
      'kopyaal = ActiveWorkbook.FullName
kopyayolla = "d:\" & dosyam
a.SaveCopyAs kopyayolla
Next
      'kopyaal = vbNullString
dosyam = vbNullString
kopyayolla = vbNullString
AyarZaman = Now + TimeSerial(1, 0, 0)
Application.OnTime AyarZaman, "Yedek"
End Sub

teşekkür ederim kardeşim oldu.

 

[webuzmani]

Dosya içerisindeki Sekmelerdeki sayfa1'i dosya ismi ile yapmak için nasıl bir değişiklik yapmam gerekiyor ?

 

[PLİNT]

Dosya içerisindeki Sekmelerdeki sayfa1'i dosya ismi ile yapmak için nasıl bir değişiklik yapmam gerekiyor ?

Merhaba.
Yukarıdaki kodlar içerisinde bulunan, aşağıdaki kırmızı tanımlamayı;

 '........
'......
For Each a In Application.Workbooks
[COLOR="Red"]dosyam = a.Name[/COLOR] 
'......
'.........

sadece "sayfa1" in adı ile kaydedilmesi için:

 dosyam = Workbooks(a.Name).Sheets(1).Name & "." & Split(a.Name, ".")(1)

"Sayfa1" adı önce "dosya" adı sonra:

dosyam = Workbooks(a.Name).Sheets(1).Name & " " & a.Name

"dosya" adı önce "sayfa1" adı sonra içinde şöyle değiştirip deneyin.

dosyam = Split(a.Name, ".") & " " & Workbooks(a.Name).Sheets(1).Name & "." & Split(a.Name, ".")(1)

Sadece "Sayfa1" i dosya olarak yedeklemek için:

Sub Yedek()
Dim a As Workbook
Dim frmt As Long
Dim kopyayolla As String, dosyam As String
frmt = Application.DefaultSaveFormat
For Each a In Application.Workbooks
dosyam = a.Name
Application.DefaultSaveFormat = Workbooks(a.Name).FileFormat
Workbooks(a.Name).Sheets(1).Copy
kopyayolla = "d:\" & dosyam
ActiveWorkbook.SaveCopyAs kopyayolla
ActiveWorkbook.Close savechanges:=False
Next
Application.DefaultSaveFormat = frmt
dosyam = vbNullString
kopyayolla = vbNullString

'..bir saat arayla tekrar için
AyarZaman = Now + TimeSerial(1, 0, 0)
Application.OnTime AyarZaman, "Yedek"
End Sub

 

[webuzmani]

Plint Öncelikle paylaşmış olduğun bilgiler için çok teşekkür ederim.

Kopya alırken bütün dosyayı değilde sadece Sayfa1'i sekmesini yedeklemek istiyorum.