Klasör oluşturma ve bu klasör içine belgenin yedeğini kopyalama.

leumruk · 31 Ağustos 2008

Selamlar...
Excel dosyasında bir buton aracılığıyla belirtilen konumda (C/ProgramFiles) kendi belirleyeceğim bir isimde klasör oluşturmak istiyorum. Bu oluşturduğum klasörün içine de yine kendi belirleyeceğim isimde bir excel dosyası oluşturup belgemin içindeki bazı sayfaları kendi ismiyle yedeklemek istiyorum.
Böyle birşeyin mümkün olduğunu biliyorum; fakat yapamıyorum.
Bundan dolayı bu karışık işlemi uzmanlarımıza havale ediyorum.
Saygılar...

NOT: Bu söylediğim işlemler tek buton aracılığıyla olacak... Ayrıca İnputboxa gerek yok, kod içinde herhangi bir isim verseniz de kafi.

Halit TÜRK · 31 Ağustos 2008

Aşağıdaki kod B2 hücresindeki isme göre sayfa yedeklemeyi yapmaktadır.
.... ve dosya ismi kısmını kendinize göre düzenleyiniz.

Sub sayfayedekle()
Dim i As String
If ActiveSheet.Range("b2").Value <> "" Then
i = ActiveSheet.Range("b2").Value
Sheets("Sayfa1").Select
Sheets("Sayfa1").Copy
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs Filename:= _
"C:\Documents and Settings\.........\Belgelerim\Dosya İsmi\" & i & ".xls", _
FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
CreateBackup:=False
Workbooks(i & ".xls").Activate
ActiveWindow.View = xlPageBreakPreview
ActiveSheet.Protect "", DrawingObjects:=True, Contents:=True, Scenarios:=True
ActiveWorkbook.Save
ActiveWorkbook.Close
' ThisWorkbook.Close
Application.DisplayAlerts = True
Else: Exit Sub
End If
End Sub

leumruk · 31 Ağustos 2008

Syn. htrk,
Dosyada uyguladım ama hata veriyor. Butona tıkladığımda belge Kitap1 adında yeni dosya oluşturuyor. Ayrıca belirttiğim konumda klasörü oluşturmuyor.
Ben düğmeye tıkladığımda yedekleme kendiliğinden olsun istiyorum. Karşıma hiçbirşey çıkmadan.
Sanırım dosyayı eklersem daha net anlaşılır:

Halit TÜRK · 1 Eylül 2008

Merhaba...
"C:\TestYedek" Klasörünü kendiniz oluşturun ve kodu çalıştırın. Sizin düzenlediğiniz koda göre test edildi, çalışıyor...
Ya da Kodu şu şekilde değiştiriniz..

Kod:

Sub sayfayedekle()
    Dim i As String
    On Error Resume Next
    Application.ScreenUpdating = False
    MkDir ("C:\" & "TestYedek")
    If ActiveSheet.Range("h2").Value <> "" Then
    i = ActiveSheet.Range("h2").Value
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Copy
    ActiveWorkbook.SaveAs Filename:= _
    "C:\TestYedek\" & i & ".xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    Workbooks(i & ".xls").Activate
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.Shapes("Button 11").Select
    Selection.Delete
    ActiveSheet.Shapes("A Grubu").Select
    Selection.Delete
    ActiveWindow.View = xlNormalView
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ' ThisWorkbook.Close
    Application.ScreenUpdating = True
    Else: Exit Sub
    End If
End Sub

leumruk · 1 Eylül 2008

Tamamdır. Şimdi oldu. Öncelikle teşekkür ederim. Fakat kodları yerleştirince yeni ihtiyaçlar ortaya çıktı. Şu an aklıma gelenleri maddelendiriyorum. İlgilenirseniz sevinirim.
1-Butona tıkladığımda aynen bu kodlarda olduğu gibi klasör oluşsun ve içinde excel dosyası oluşsun.(Bu tamam.)
2- Ardından yeni işlem yaptığımda eskisini silsin ve yenisini kaydetsin veya "Bu isimde bir dosya var, yenisiyle değiştirmek istiyor musunuz" şeklindeki sorgu ekranı gelmeden yeni yedeği kaydetsin.
3- Birden fazla sayfanın yedeğini aynı anda alamaz mıyız?
4- Son olarak yedeğini aldığımız sayfaları, tekrar bir buton aracılığıyla anadosyamıza aynı isimle çağırabilir miyiz? Eski sayfayı silip yerine yedeklemiş olduğumuz yeni sayfayı getirecek.

Korhan Ayhan · 2 Eylül 2008

Selamlar,

Aşağıdaki kodu denermisiniz. Yedeğini almak istediğiniz sayfaları seçip makroyu çalıştırın. Her sayfayı kendi ismiyle ayrı birer kitap olarak "C:\YEDEK" klasörüne kayıt edecektir.

Kod:

Sub Yedek_Al()
    On Error Resume Next
    
    Dim Fso As Object, Sayfa As Object
    Dim Dosya_Yolu As String, Dosya_Ad&#305; As String
    
    Dosya_Yolu = "C:\YEDEK"
    
    Set Fso = CreateObject("Scripting.FileSystemObject")
    
    If Not Fso.FolderExists(Dosya_Yolu) Then
    Fso.CreateFolder (Dosya_Yolu)
    End If
    
    For Each Sayfa In ActiveWindow.SelectedSheets
    Sheets(Sayfa.Name).Copy
    Dosya_Ad&#305; = Sayfa.Name & ".xls"
    ActiveWorkbook.SaveAs Filename:=Dosya_Yolu & Application.PathSeparator & Dosya_Ad&#305;
    ActiveWorkbook.Close 0
    Next
    Sheets(1).Select
    
    Set Fso = Nothing
End Sub

leumruk · 2 Eylül 2008

Syn. Korhan Hocam,
Sayfa isimlerini kod içine yazarak bu işlemi yapamaz mıyız? Çünkü yedeği alınacak sayfalar değişmeyecek.
Bir de geri çağırma şansımız yok mu?
İşlem yapmadan önce yedek klasörü silinip, yeni yedeği kaydetme şansımız var mı? Uyarı ekranının gelmemesi için?
Saygılar.

Korhan Ayhan · 2 Eylül 2008

Selamlar,

Sayfa isimleri olarak ne verilecek?

Ayrıca yedeklenen sayfayı geri çağırdığınızda eğer eski sayfa ile başka sayfalar arasında bağlantılı formüller varsa sıkıntı yaratacaktır.

Halit TÜRK · 2 Eylül 2008

5. Mesajınız 1 ve 2. sorunun cevabı olarak kodu aşağıdaki gibi değiştiriniz. Aynı sayfa varsa sormadan üzerine kaydediyor. (Alternatif)

Kod:

Sub sayfayedekle()
    With Application
        .ScreenUpdating = False
        .DisplayAlerts = False
    End With
    Dim i As String
    On Error Resume Next
    MkDir ("C:\" & "TestYedek")
    If ActiveSheet.Range("h2").Value <> "" Then
    i = ActiveSheet.Range("h2").Value
    Sheets("Sayfa1").Select
    Sheets("Sayfa1").Copy
    ActiveWorkbook.SaveAs Filename:= _
    "C:\TestYedek\" & i & ".xls", _
    FileFormat:=xlNormal, Password:="", WriteResPassword:="", ReadOnlyRecommended:=False, _
    CreateBackup:=False
    Workbooks(i & ".xls").Activate
    ActiveWindow.View = xlPageBreakPreview
    ActiveSheet.Shapes("Button 11").Select
    Selection.Delete
    ActiveSheet.Shapes("A Grubu").Select
    Selection.Delete
    ActiveWindow.View = xlNormalView
    ActiveWorkbook.Save
    ActiveWorkbook.Close
    ' ThisWorkbook.Close
    Else: Exit Sub
    End If
    With Application
        .DisplayAlerts = True
        .ScreenUpdating = True
    End With
    MsgBox "Kaydedildi...", vbInformation
End Sub

Halit TÜRK · 2 Eylül 2008

Korhan bey, sizin yazmış olduğunuz kod içinde; sayfa adı ve dosya adını [B2] den alması için nasıl bir değişiklik yapılmalıdır.

Aşağıdaki ilavelerle hallettim teşekkürler..

Kod:

    Dim i As String
        i = ActiveSheet.Range("B2").Value
    Dosya_Ad&#305; = i & ".xls"

leumruk · 2 Eylül 2008

Syn. Htrk,
Çok teşekkür ederim. Geri çağırmayı da elbette halledecek arkadaşımız çıkacaktır.
Saygılar...

leumruk · 2 Eylül 2008

Korhan Ayhan' Alıntı:
Selamlar,

Sayfa isimleri olarak ne verilecek?

Ayrıca yedeklenen sayfayı geri çağırdığınızda eğer eski sayfa ile başka sayfalar arasında bağlantılı formüller varsa sıkıntı yaratacaktır.

Sayfa isimleri "Veri, Veri2, Veri3, Veri4, CVP, CVP2, CVP3, CVP4" toplam sekiz sayfa.
Bu belirttiğim sayfalarda bir tane bile formül yok. Yani sıkıntı yok. Değiştirilebilir.
Fakat bunların dışında bir Ana sayfam bir de "Kriter" isimli bir sayfam var. Bunlarda hiçbir değişiklik olmaması gerekiyor. Tüm işlemler bu belirttiğim iki sayfa üzerinde gerçekleşiyor. Diğerleri verilerin kaydedildiği bölüm. Silindiği zaman problem oluşturmaz.
Saygılar...

Korhan Ayhan · 2 Eylül 2008

Selamlar,

Ekteki örnek dosyayı incelermisiniz. Kendi dosyanıza uyarlarken ÖRNEK yazan kısımları kendi dosya adınızla değiştirmeyi unutmayın.

leumruk · 2 Eylül 2008

Syn. Korhan hocam,
Çok teşekkür ederim, gayet güzel olmuş.
Kodlarla ilgili birkaç sorum olacak, Klasörü her defasında yeniden mi oluşturuyor; yoksa makroyu ilk çalıştırdığımızda klasörü oluşturup, sonraki işlemlerde yeniden klasör oluşturmayıp oluşturulmuş klasör içine işlem mi yapıyor?
Aynı soru klasör içindeki dosya içinde geçerli. Eski dosyayı silip yenisini mi kopyalıyor; yoksa makro ilk çalıştığında dosyayı oluşturup, diğer işlemleri bu dosya içinde değişiklikler yaparak mı gerçekleştiriyor?
Son olarak, kodlarda büyük bir değişiklik gerektirmeyecekse yedekleri toplu halde çağırma seçeneği de ekleyebilr miyiz? Tek tek çağırma işlemi kalacak.
Tekrar teşekkür ederim.
Saygılar...

Korhan Ayhan · 3 Eylül 2008

Selamlar,

İlk sorunuz;

Kodu ilk çalıştıdığınızda eğer C diski içinde YEDEK isimli klasör yoksa otomatik olarak oluşturur. Sonraki işlemlerde tekrar tekrar klasör oluşturulmamaktadır.

İkinci sorunuz;

Dosyaları ise YEDEK klasörü içinde daha önce kaydedilmiş aynı isimli dosya varsa direk üzerine kaydeder. Eğer dosya ilk kez yedekleniyorsa yeni dosya oluşturup kaydeder.

Üçüncü sorunuz;

Üstteki mesajımdaki dosyayı güncelledim. Tüm sayfaları yedekten geri alma özelliğide eklenmiştir. İncelermisiniz.

Halit TÜRK · 3 Eylül 2008

Selamlar, Korhan bey çalışmanız mükemmel olmuş. Ellerinize sağlık...
Aynı konu ile ilgili bir sorum olacak.
Dosya adının "DATA" olduğunun düşünürsek, kaydederken "DATA" isimli sayfa varsa, "DATA (1)", "DATA (2)" şeklinde kaydetmesini nasıl sağlayabiliriz. Teşekkürler...
Birde makroyu F12 tuşuna nasıl bağlıyorsunuz. (F12) tuşunu anladım..

Korhan Ayhan · 3 Eylül 2008

Selamlar,

Sn. htrk,

Burada dosyayı yedeklemiyoruz içindeki sayfaları yedekliyoruz. Dediğiniz şekilde sayfalar yada dosyalar yedeklenebilir tabiki. Fakat buradaki amaç nedir?

Halit TÜRK · 3 Eylül 2008

Selam,

Dosya değil yanlış anlattım, sayfa yedeklemek için, teklif hazırlıyorum ve kaydediyorum, aynı kişi adına göre teklif varsa Ali ise Ali (1) olarak kaydetmesidir.

Not: Benim koduma göre de olabilir. İsmi (B2) den alıyorum

leumruk · 3 Eylül 2008

Syn. Korhan hocam,
Çok teşekkür ederim. Kodlar tam istediğim gibi.
Saygılar...

Korhan Ayhan · 3 Eylül 2008

Selamlar,

Sn. htrk,

Örnek olarak eklemiş olduğum dosyadaki YEDEK_AL kodunu aşağıdaki şekilde değiştirip denermisiniz.

Kod:

Sub YEDEK_AL()
    On Error Resume Next
    Dim Fso As Object
    Dim Dosya_Yolu As String, Dosya_Ad&#305; As String, Sayfa_Ad&#305; As String
    Dim Sayfalar()
    Dim X As Long, Ek As Integer
    Dosya_Yolu = "C:\YEDEK"
    Sayfalar = Array("Veri", "Veri2", "Veri3", "Veri4", "CVP", "CVP2", "CVP3", "CVP4")
    Ek = 1
    Set Fso = CreateObject("Scripting.FileSystemObject")
    
    If Not Fso.FolderExists(Dosya_Yolu) Then
    Fso.CreateFolder (Dosya_Yolu)
    End If
    
    Application.ScreenUpdating = False
    For X = 0 To UBound(Sayfalar)
    Sayfa_Ad&#305; = Evaluate("=UPPER(""" & Sayfalar(X) & """)")
    If SAYFA(Sayfa_Ad&#305;) Then
    Sheets(Sayfalar(X)).Copy
    Dosya_Ad&#305; = Sayfa_Ad&#305; & ".xls"
    
    If Dir(Dosya_Yolu & Application.PathSeparator & Dosya_Ad&#305;, vbNormal) = "" Then
    ActiveWorkbook.SaveCopyAs Filename:=Dosya_Yolu & Application.PathSeparator & Dosya_Ad&#305;
    ActiveWorkbook.Close 0
    GoTo Son
    End If
Devam:
    If Dir(Dosya_Yolu & Application.PathSeparator & Sayfa_Ad&#305; & " " & Ek & ".xls", vbNormal) = "" Then
    ActiveWorkbook.SaveCopyAs Filename:=Dosya_Yolu & Application.PathSeparator & Sayfa_Ad&#305; & " " & Ek & ".xls"
    ActiveWorkbook.Close 0
    Else
    Ek = Ek + 1
    GoTo Devam
    End If
    End If
Son:
    Next
    Sheets(1).Select
    Application.ScreenUpdating = True
    Set Fso = Nothing
    MsgBox "Yedekleme i&#351;lemi tamamlanm&#305;&#351;t&#305;r.", vbInformation
End Sub

Klasör oluşturma ve bu klasör içine belgenin yedeğini kopyalama.

leumruk

Uzman

Halit TÜRK

leumruk

Uzman

Halit TÜRK

leumruk

Uzman

Korhan Ayhan

Administrator

leumruk

Uzman

Korhan Ayhan

Administrator

Halit TÜRK

Halit TÜRK

leumruk

Uzman

leumruk

Uzman

Korhan Ayhan

Administrator

leumruk

Uzman

Korhan Ayhan

Administrator

Halit TÜRK

Korhan Ayhan

Administrator

Halit TÜRK

leumruk

Uzman

Korhan Ayhan

Administrator