Araç çubuğuna "Yedekleme Butonu" ekleme

[internetturk]

Bir çok örneğe baktım ama aradığım gibi bişi bulamadım. Araççubuğuna bir buton koyayım ve butona tıklayınca yedek alsın ve kapatsın.
İstediğim şu :
1. Belirlediğim klasöre yedek alsın. Herseferinde dosya yolunu sormasın.
2. Dosya adının yanına tarih ekleyerek isimlendirsin. Dosya varsa üzerine yazsın.
3. Yedek aldıktan sonra otomatik kapatsın.

 

[dEdE]

mrb.,
Ekli dosyayı incelermisiniz.

 

[umutsancar]

Merhaba,

Bunu bir deneyin.

Sub Yedekle()
Dim fName As String
fName = "yedek"
klasor = "C:\YEDEK\"
fName = fName & " " & Format(Date, "DD-MM-YYYY") & ".xls"
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:=klasor & fName
Application.DisplayAlerts = True
ActiveWorkbook.Close
End Sub

 

[karamurselli]

Sn dEdE,
Ne kadar güzel kodlar, ne güzel açıklama :bravo:

 

[dEdE]

Tşk.
Yardımcı olabildiğime sevindim.

 

[internetturk]

Sn dEdE , çok güzel açıklamışsınız. Ek olarak sizinkine ek olarak dosya adına saat ve dakika da vermek istedim ama beceremedim.
Bu konuda yardımcı olabilir misiniz?

 

[dEdE]

"C:\Documents and Settings\KULLANICIADI\Belgelerim\xx\Yedek-" & Date & ".xls", FileFormat:= _

buradaki Date komutunu Now komutu ile değiştirin

 

[internetturk]

Ok tşk ler. Gerçekten çok makbule geçti.
Yalnız bir nokta dikkatimi çekti "Ana Çalışma Dosyası" nı kaydetmiyor :yardim:

 

[aliakgul]

Sub Yedekle()
Application.DisplayAlerts = False
'KULLANICIADI bölümüne kendi dosya yolunu yazmalısın
ChDir "C:\Documents and Settings\KULLANICIADI\Belgelerim\xx"
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\KULLANICIADI\Belgelerim\xx\Yedek-" & Date & ".xls", FileFormat:= _
xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
, CreateBackup:=False
Application.DisplayAlerts = True
Application.Quit
End Sub

Arkadaşlar ellerinize,gönüllerinize sağlık...........
Sayın DEDE,
Bu kodlar sizin çalışmanızdan... Bu kodlarla çalışma kitabının tamamını yedekliyorsunuz.Çalışma kitabındaki sadece bir çalışma sayfasını (örneğin Liste adlı sayfamızı) yedeklemek istesek????

 

[dEdE]

xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _

Yukarıdaki satırda xlNormal komutunu xlExcel4 komutu ile değiştiriniz. Ancak bu defa makronuz yok olacaktır. Başka bir çözüm var sanıyorum ama, ancak yarın bakabileceğim.

 

[Recep İpek]

Merhaba,

Bir alternatifte benden olsun.

Makro önce C:'de Yedek klasörünün olup olmadığını kontrol ediyor.

Yok ise Yedek klasörü yaratıp içine dosyayı kopyalayarak, sadece ilgili dosyayı kapatıyor.

Kolay gelsin.
[vb:1:cdea26e370]
Sub YedekAl()
On Error Resume Next
Dim FSO As Object
Dim MyFolder, MyFile, MyFileEnd As String
Dim s As Long
MyFolder = "C:\Yedek"
MyFile = "RAPOR"
MyFileEnd = MyFile & " " & Format(Now, "dd mm yyyy hh mm") & ".xls"
Set FSO = CreateObject("Scripting.FileSystemObject")

If Not FSO.FolderExists(MyFolder) Then
FSO.CreateFolder (MyFolder)
End If

ActiveWorkbook.SaveCopyAs Filename:=MyFolder & Application.PathSeparator & MyFileEnd

Set FSO = Nothing

s = Excel.Application.Windows.Count
If s = 1 Then
Application.Quit
Else
ActiveWorkbook.Close
End If
'www.excel.web.tr
End Sub[/vb:1:cdea26e370]

 

[abdi]

benim bilgisayarda kodları deneyim dedim fakat biliyorsunuzki excelde dosya isimlerinde özellikle tarih ve saat yazılan verilerde.(nokta) ve / (ayraç) karekterlerini dosya adına yazmıyor ve kodda hata veriyordu bende şöyle bir çözüm geliştirdim.
örnek olması açısından kodları ekliyorum.
aşağıdaki kodlamada yedekleme klasörü olarak "c:\yedek1\"olduğu varsayılmıştır.

Sub Yedekle()
    Dim i As String
    Dim b As String
    Dim c As String
    Dim d As String
    Application.DisplayAlerts = False
    b = Len(Right(ActiveWorkbook.Name, 4))
    Debug.Print b
        i = Len(ActiveWorkbook.Name)
        c = Left(ActiveWorkbook.Name, (i - b))
    Debug.Print c
    Debug.Print i
        d = Format(Now, "dd mm yyyy hh mm nn")
        ActiveWorkbook.SaveAs Filename:= _
        "C:\yedek1\" & c & d & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        Application.DisplayAlerts = True
        ActiveWorkbook.Save
        Application.Quit
End Sub

 

[abdi]

aşağıdaki kod aktif olan sayfayı yeni sayfaismi tarih ssat olarak kaydeder
C:\yedek1\ klasörüne kaydeder

Sub sayfayedekle()
Dim i As String
Dim b As String

i = ActiveSheet.Name
b = Format(Now, "dd mm yyyy hh mm nn")
ActiveSheet.Select
ActiveSheet.Copy
ActiveWorkbook.SaveAs Filename:= _
        "C:\yedek1\" & i & b & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        Application.DisplayAlerts = True
        
       Workbooks(i & b & ".xls").Activate
       ActiveWorkbook.Close
       ActiveWorkbook.Save


End Sub

 

[xxrt]

Gerçekten çok güzel..abdi,

 

[aliakgul]

Çalışma kitabındaki sadece bir çalışma sayfasını (örneğin Liste adlı sayfamızı) yedeklemek istesek????

Arkadaşlar, sayın DEDE'nin hazırladığı kodlarda küçük bir değişiklik demiştim........

 

[Haluk]

Dosyanın "yedeklenmesi" ile ilgili alternatif:

http://www.excel.web.tr/viewtopic.php?p=10757#10757

 

[abdi]

Sayın aliakgul,

Sub listesayfasınıyedekle()
Dim i As String
Dim b As String

i = Sheets("Liste").Name

b = Format(Now, "dd mm yyyy hh mm nn")
Sheets("Liste").Select
Sheets("Liste").Copy
ActiveWorkbook.SaveAs Filename:= _
        "C:\yedek1\" & i & b & ".xls", FileFormat:= _
        xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False _
        , CreateBackup:=False
        Application.DisplayAlerts = True
        
       Workbooks(i & b & ".xls").Activate
       ActiveWorkbook.Close
       ActiveWorkbook.Save
End Sub

 

[yyhy]

bir örnek sayfa atabilirmisiniz..

arkadaşlar bir örnek sayfa atabilirmisiniz....atabilirseniz memmun olurum..