yedekleme

Y

yetiskol

Katılım
7 Nisan 2008
Mesajlar
37
Excel Vers. ve Dili
2000sb-2003sb-xp standart
arkadaslar selamlar ben yapmış oldugum excel vb kullanarak yedek al butonu koydum. İstediğim olay tarih olarak hangi gündeysek Örneğin : 09 nisan 2008 olarak yedek almasını istiyorum .fakat hata veriyor.

Private Sub CommandButton15_Click()
cevap = MsgBox("Bilgilerinizin son hali bugunku tarihle farklı kayıt edilerek yedeklenecektir. Yedeklenen bilgilere :" & yedekyolu & " My Documents ''Belgelerim'' klasöründen erişebilirsiniz. Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")
If cevap = vbNo Then
GoTo son
End If
Application.StatusBar = " Belgeniz: C:\Windows\desktop\doluluk\doluluk tablosu-" & Date & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
dosyaadi = "DOLULUK YEDEK-" & Str(Date)
ActiveWorkbook.SaveAs Filename:=dosyaadi & ".xls"
son:
end sub

hata verdiği yerdiği yer kırmızı olarak belirtilmiştir.
Bilenlerin çok acil yardım etmesi dileğiyle
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Kodlarınızı aşağıdaki gibi değiştiriniz. Denedim, ben de hata vermedi ... Eğer aşağıdakiler sizde hata verirse, sorun başka bir şeyden kaynaklanıyordur.

NOT : Mevcut kodlarınızla, Desktop'a veri kaydetmek her zaman mükmkün olmaz. Çünkü SaveAs komutunda herhangi bir yol (path) belirtmemişsiniz. Bu nedenle, o an aktif olan klasör neyse kayıt oraya yapılır. Aşağıdaki kodlar ise direkt Desktop klasörüne kayıt yapar.

NOT2: Bir dahaki sefer sadece hata veren satırı değil. Hatanın da ne olduğunu özellikle bildiriniz

Kod: 
    Dim dzn As String
    Dim dosyayolu As String
    Dim ws As Object
 
    cevap = MsgBox("Bilgilerinizin son hali " & _
                   "bugunku tarihle farklı " & _
                   "kayıt edilerek yedeklenecektir. " & _
                   "Yedeklenen bilgilere :" & yedekyolu & _
                   " My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
                   "Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")
 
    If cevap = vbYes Then
 
        Set ws = CreateObject("WScript.Shell")
 
        dzn = ws.SpecialFolders("Desktop")
 
        dosyayolu = dzn & Application.PathSeparator & "DOLULUK YEDEK-" & Str(Date) & ".xls"
 
        Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
 
        ActiveWorkbook.SaveAs dosyayolu
 
        Set ws = Nothing
 
        Application.StatusBar = ""
 
    End If
 
Y

yetiskol

Katılım
7 Nisan 2008
Mesajlar
37
Excel Vers. ve Dili
2000sb-2003sb-xp standart
ilginin için teşekkür ederim . Ama gene hata verdi kırmızıyla belirttim. Ama hata tahmin ettiğim doğruysa 10/04 (.,/\vb.) şeklinde kayıt yapmamıza izin vermiyor. Bunun yerine tarihi 10nisan2008 şeklinde kayıt etmemizi sağlayacak bişey varmı


Dim dzn As String
Dim dosyayolu As String
Dim ws As Object

cevap = MsgBox("Bilgilerinizin son hali " & _
"bugunku tarihle farklı " & _
"kayıt edilerek yedeklenecektir. " & _
"Yedeklenen bilgilere :" & yedekyolu & _
" My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
"Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")

If cevap = vbYes Then

Set ws = CreateObject("WScript.Shell")

dzn = ws.SpecialFolders("Desktop")

dosyayolu = dzn & Application.PathSeparator & "DOLULUK YEDEK-" & Str(Date) & ".xls"

Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"

ActiveWorkbook.SaveAs dosyayolu

Set ws = Nothing

Application.StatusBar = ""

End If
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Dosya adlarında belirttiğiniz karakter kullanılamaz.

Kodlarınızdaki Str(Date) fonksiyonu yerine, ya Format(Date, "ddmmmmyyyy") ya da Replace(Str(Date), "/", ".") fonksiyonunu kullanın. Böylelikle; sorun çözülür.
 
Y

yetiskol

Katılım
7 Nisan 2008
Mesajlar
37
Excel Vers. ve Dili
2000sb-2003sb-xp standart
teşekkür ederim. Ellerine Sağlık harika oldu. Bişey daha sorsam :)

Kaydeceğim yeri desktop yerine gözat penceri açılarak istediğimiz yere kopyalamamızı nasıl sağlayabiliriz.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
O zaman kodunuzu aşağıdaki gibi değiştirmeniz gerekir.

Kod: 
    Dim dzn As String
    Dim dosyayolu As String
    Dim shl As Object
    cevap = MsgBox("Bilgilerinizin son hali " & _
                   "bugunku tarihle farklı " & _
                   "kayıt edilerek yedeklenecektir. " & _
                   "Yedeklenen bilgilere :" & yedekyolu & _
                   " My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
                   "Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")
 
    If cevap = vbYes Then
 
        Set shl = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
        
        If shl Is Nothing Then
            MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
            Exit Sub
        Else
            dzn = shl.Items.Item.Path
        End If
        dosyayolu = dzn & Application.PathSeparator & "DOLULUK YEDEK-" & Format(Date, "ddmmmmyyyy") & ".xls"
 
        Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
 
        ActiveWorkbook.SaveAs dosyayolu
 
        Application.StatusBar = ""
 
        Set shl = Nothing
    End If
 
H

hassan26

Katılım
5 Ağustos 2007
Mesajlar
247
Excel Vers. ve Dili
excel 2003 tr
Sayın Ferhat bey forum içindeki konuları okurken ilgimi çekti kod çok güzel çalışıyor. Merak ettim userformlar ile yönetilen çalışma kitabında farklı kaydet veya yedek al gibi kodlarda işlem gerçekleşirken VBA kısmı değilde sadece excel sayfaları yedeklenebilirmi yedeklere başvurulduğunda formlar falan olmasa sadece sayfalar olsa. Mümkünmüdür.
Saygılar.
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Kodu şu şekilde revize edebilirsiniz. Başka ayrıntılı alternatifler de düşünülebilir tabi.

ÖNEMLİ NOT : Kodu çalıştırmadan önce; menüden Araçlar->Seçenekler komutunu verin. Güvenlik sekmesini seçip, Makro Güvenliği düğmesine tıklayın. Güvenilen Yayımcılar sekmesinde, "Visual Basic Project erişimine güven" i işaretleyin.

Kod: 
Sub Yedekleme()
    Dim dzn As String
    Dim dosyayolu As String
    ......
    ...... 
        Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
        ActiveWorkbook.SaveAs dosyayolu
[COLOR=red][B]          Call UF_ve_MODULLERI_Yoket[/B][/COLOR]
        Application.StatusBar = ""
        Set shl = Nothing
    End If
End Sub
'-----------------------
Sub UF_ve_MODULLERI_Yoket()
    Dim vbeCol As Object [COLOR=green]'VBE'deki tüm Component koleksiyonu
[/COLOR]    Dim vbeCom As Object[COLOR=green] 'VBE'deki herhangi bir Component
[/COLOR]    Set vbeCol = Application.VBE.ActiveVBProject.VBComponents
    For Each vbeCom In vbeCol
[COLOR=green]        'VBE'deki tüm componentler için
[/COLOR]        If vbeCom.Type = 1 Or vbeCom.Type = 3 Then
[COLOR=green]            'Eğer Component Module veya Userform ise
[/COLOR]           vbeCol.Remove vbeCol.Item(vbeCom.Name)
[COLOR=green]            'Sil
[/COLOR]        End If
    Next
End Sub
 
H

hassan26

Katılım
5 Ağustos 2007
Mesajlar
247
Excel Vers. ve Dili
excel 2003 tr
Selam Sayın Ferhat bey kodu bu şekilde kullandım gayet güzel ellerinize sağlık ama Ben orjinal dosyada çalışırken yedek almasını istedim kod çalışma işleminin sonunda benim asıl dosya kayboldu yedek dosya aktif oldu kapat yapıncada ZİMMET YEDEK içinde yaptığınız deşiklikleri kaydetmek istiyormusunuz diye soruyla karşılaşıyorum. Bunu engellemek mümkünmü yani kod sessizce işlemini bitirip kapansa.
Saygılar.
"Visual Basic Project erişimine güven" fazlamı güvendim acaba:)
Private Sub CommandButton36_Click()
Dim dzn As String
Dim dosyayolu As String
Dim shl As Object
cevap = MsgBox("Bilgilerinizin son hali " & _
"bugunku tarihle farklı " & _
"kayıt edilerek yedeklenecektir. " & _
"Yedeklenen bilgilere :" & yedekyolu & _
" My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
"Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")

If cevap = vbYes Then

Set shl = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)

If shl Is Nothing Then
MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
Exit Sub
Else
dzn = shl.Items.Item.Path
End If
dosyayolu = dzn & Application.PathSeparator & "ZİMMET YEDEK-" & Format(Date, "ddmmmmyyyy") & ".xls"

Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"

ActiveWorkbook.SaveAs dosyayolu
Call UF_ve_MODULLERI_Yoket
Application.StatusBar = ""

Set shl = Nothing
End If
End Sub
'----------------------------------
Sub UF_ve_MODULLERI_Yoket()
Dim vbeCol As Object 'VBE'deki tüm Component koleksiyonu
Dim vbeCom As Object 'VBE'deki herhangi bir Component
Set vbeCol = Application.VBE.ActiveVBProject.VBComponents
For Each vbeCom In vbeCol
'VBE'deki tüm componentler için
If vbeCom.Type = 1 Or vbeCom.Type = 3 Then
'Eğer Component Module veya Userform ise
vbeCol.Remove vbeCol.Item(vbeCom.Name)
'Sil
End If
Next
End Sub
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Doğrudur ... Ben de önünü arkasını düşünmeden sallama yazmışısım galiba kodları :) ... Kusura bakmayın artık ...

CommmandButton6'nın kodlarını şu şekilde revize edin. Değişikliği takip etmeniz açısından, bunları kırmızı ile gösterdim. İnceleyiniz.

Kod: 
Private Sub CommandButton36_Click()
    Dim dzn As String
    Dim dosyayolu As String
    Dim shl As Object
[COLOR=red]    Dim AnaDosya As String[/COLOR]
    cevap = MsgBox("Bilgilerinizin son hali " & _
                   "bugunku tarihle farklı " & _
                   "kayıt edilerek yedeklenecektir. " & _
                   "Yedeklenen bilgilere :" & yedekyolu & _
                   " My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
                   "Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")
    
    If cevap = vbYes Then
        Set shl = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
        If shl Is Nothing Then
            MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
            Exit Sub
        Else
            dzn = shl.Items.Item.Path
        End If
        
[COLOR=red]        ThisWorkbook.Save
        AnaDosya = ThisWorkbook.FullName[/COLOR]
        dosyayolu = dzn & Application.PathSeparator & "ZİMMET YEDEK-" & Format(Date, "ddmmmmyyyy") & ".xls"
        Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
[COLOR=blue]        Call UF_ve_MODULLERI_Yoket[/COLOR]
        ActiveWorkbook.SaveAs dosyayolu
[COLOR=red]        Application.ScreenUpdating = False
        ActiveWorkbook.Close 0[/COLOR]
[COLOR=red]        Workbooks.Open AnaDosya
        Application.ScreenUpdating = True[/COLOR]
        Application.StatusBar = ""
        Set shl = Nothing
    End If
End Sub
 
H

hassan26

Katılım
5 Ağustos 2007
Mesajlar
247
Excel Vers. ve Dili
excel 2003 tr
Üstad bu sefer her ikiside gidiyor hem yedek hem anadosya gri ekranlı halde excel pasif kalıyor satus barda lütfen bekleyin mesajı 10 dakika bekledim manuel kapattım yedek aldığı yere bakıyorum yedeği almış ama birebir almış yani VBA da mevcut
AnaDosya = ThisWorkbook.FullName
Workbooks.Open AnaDosya
kısmında ki anadosya yazan yerlere gerçek adını yazmammı gerekirdi eğer öyleyse bunuda denedim sonuç aynı olmadı.
Saygılar
 
F

Ferhat Pazarçevirdi

Özel Üye
Katılım
15 Haziran 2006
Mesajlar
3,704
Excel Vers. ve Dili
Excel 2003, 2007, 2010 (TR)
Application.ScreenUpdating ... ile başlayan her iki satırı da silin ve yeniden kodları çalıştırın.
 
H

hassan26

Katılım
5 Ağustos 2007
Mesajlar
247
Excel Vers. ve Dili
excel 2003 tr
Üstadım sonuç aynı kodun neresi yanlış bi el atarmısın
Private Sub CommandButton36_Click()
Dim dzn As String
Dim dosyayolu As String
Dim shl As Object
Dim AnaDosya As String
cevap = MsgBox("Bilgilerinizin son hali " & _
"bugunku tarihle farklı " & _
"kayıt edilerek yedeklenecektir. " & _
"Yedeklenen bilgilere :" & yedekyolu & _
" My Documents ''Belgelerim'' klasöründen erişebilirsiniz. " & _
"Devam etmek istiyor musunuz..?", vbYesNo, "Yedek Alma...")

If cevap = vbYes Then
Set shl = CreateObject("Shell.Application").BrowseForFolder(0, "Lütfen bir klasör seçin !", &H100)
If shl Is Nothing Then
MsgBox "Herhangi bir klasör seçmediniz", vbCritical, "UYARI"
Exit Sub
Else
dzn = shl.Items.Item.Path
End If

ThisWorkbook.Save
tutanak_zimmet1 = ThisWorkbook.FullName
dosyayolu = dzn & Application.PathSeparator & "ZİMMET YEDEK-" & Format(Date, "ddmmmmyyyy") & ".xls"
Application.StatusBar = " Belgeniz: " & dosyayolu & " olarak kaydediliyor... Lutfen Bekleyiniz..!"
Call UF_ve_MODULLERI_Yoket
ActiveWorkbook.SaveAs dosyayolu
ActiveWorkbook.Close 0
Workbooks.Open tutanak_zimmet1
Application.StatusBar = ""
Set shl = Nothing
End If
End Sub
Sub UF_ve_MODULLERI_Yoket()
Dim vbeCol As Object 'VBE'deki tüm Component koleksiyonu
Dim vbeCom As Object 'VBE'deki herhangi bir Component
Set vbeCol = Application.VBE.ActiveVBProject.VBComponents
For Each vbeCom In vbeCol
'VBE'deki tüm componentler için
If vbeCom.Type = 1 Or vbeCom.Type = 3 Then
'Eğer Component Module veya Userform ise
vbeCol.Remove vbeCol.Item(vbeCom.Name)
'Sil
End If
Next
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst