Buton İle yedek alma ve Kod, UserForm, Modul Silme ?

[Beyfendi]

Merhaba Üstadlarım,

Aşağıdaki kod ile istediğim klasöre Excel VBA çalışmamın yedeğini alabiliyorum, yedekleme esnasında yedek aldığım dosyadan bütün Kod, Userform ve module leri aşağıda belirttiğim kod ile yedeklediğim dosyadan sildirebiliyorum.

Buraya kadar tamam ama ben farklı bir şey yapmak istiyorum ve yapmak istediğimi bir türlü kodlayamadım siz üstadların yardımına ihtiyacım var.

Fotoda belirttiğim Module2 hariç BuÇalışmaKitabındaki Kodlar, Userformlar ve Module1-3-4 silinerek yedek aldırmak.

Şimdiden yardımcı olan üstada çok çok teşekkür ederim.

Kod: Tümünü seç

Private Sub Kapat_Click()

Dim Yol As String, Sayfa As Worksheet
    
    Yol = "D:\Yedekler"
    If Dir(Yol, vbDirectory) = "" Then MkDir (Yol)

'    If MsgBox("Dosyanın yedeğini almak istiyor musunuz?", vbInformation + vbYesNo + vbDefaultButton2) = vbNo Then
'        MsgBox "İşlemi iptal ettiniz!", vbExclamation
'        Exit Sub
'    End If
    
    ThisWorkbook.Save
'    ThisWorkbook.SaveCopyAs Yol & "\" & ThisWorkbook.Name & " - " & Format(Now, "dd.mm.yyyy hh_nn_ss")
    
    ThisWorkbook.Sheets.Copy
    
    For Each Sayfa In ActiveWorkbook.Worksheets
        If Sayfa.DrawingObjects.Count > 0 Then
            Sayfa.DrawingObjects.Visible = True
            Sayfa.DrawingObjects.Delete
        End If
    Next
    
    ActiveWorkbook.SaveAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " - " & Replace(ThisWorkbook.Name, "xlsm", "xlsx"), 51
    ActiveWorkbook.Close
    
'    MsgBox "Dosya 'D:' sürücüsündeki YEDEKLER klasörüne yedek kaydedildi.", vbInformation


Application.ScreenUpdating = False
Unload Me
Workbooks("STOK TAKİP v2.xlsm").Save
Workbooks("STOK TAKİP v2.xlsm").Close
Application.Quit
End Sub

[sahin]

dosya menüsünden "seçenekler/güvenlik merkezi/ güvenlik merkezi ayarları/ makro ayarlarında >>"VBA projesi nesnesi mokeli erişimine güve" seçip deneyin

Kod: Tümünü seç

Sub sil()
On Error Resume Next
 
    i = 0
   
    For Each moduller In ActiveWorkbook.VBProject.VBComponents
     i = i + 1
   
     If ActiveWorkbook.VBProject.VBComponents(i).Name = "BuÇalışmaKitabı" Then
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.DeleteLines 1, _
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.CountOfLines
     End If
     If ActiveWorkbook.VBProject.VBComponents("Module" & i).Name <> "Module2" Then
      ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module" & i)
     
     End If
     
    Next moduller
End Sub

[Beyfendi]

Üstad öncelikle çok çok teşekkür ederim yardımından dolayı,

Vermiş olduğun kodu benim kodla aşağıdaki gibi birleştirip çalıştırdığımda,

Kod: Tümünü seç

 Sub Kapat()
Dim Yol As String, Sayfa As Worksheet
    
    Yol = "D:\Yedekler"
    ThisWorkbook.Save
    ThisWorkbook.SaveCopyAs Yol & "\" & Format(Now, "dd.mm.yyyy hh_nn_ss") & " - " & ThisWorkbook.Name

    ThisWorkbook.Sheets.Copy

     i = 0
   
    For Each moduller In ActiveWorkbook.VBProject.VBComponents
     i = i + 1
   
     If ActiveWorkbook.VBProject.VBComponents(i).Name = "BuÇalışmaKitabı" Then
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.DeleteLines 1, _
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.CountOfLines
     End If
     If ActiveWorkbook.VBProject.VBComponents("Module" & i).Name <> "Module2" Then
    ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module" & i)
     
     End If
     
    Next moduller
    ActiveWorkbook.Close

End Sub

1 - Ana dosyadan silme işlemi yaptı üstad benim yapmak istediğim yedeklenen dosyadan silinmesini istediklerimi silmesi, Kullanmış olduğum ana dosyada hiçbir işlem yapmayacak yedeklenen dosyadan belirttiklerim silinecek.
2 - Benim kodla birleştirince ana dosyadan sadece "BuÇalışmaKitabı" daki kodları sildi *UserForm"ları ve "Module1-3-4" leri silmedi ve kodun If ActiveWorkbook.VBProject.VBComponents("Module" & i).Name <> "Module2" Then bu satırında hata verdi.

Üstad bir numarada belirttiğim gibi kullanmış dolduğum ana dosyada hiçbir işlem yapmayacak yedeklenen dosyadan, altdaki fotoğraf da belirttiğim silme işlemlerini yapıp belirtilen yola veya yere yedeği kaydedecek.

(Ana Dosyayı Kopyala ==> Kopyalanan dosyadan Fotodaki Silme işlemlerini Yap ==> Belirtilen Yola/Yere Kaydet)

dosya menüsünden "seçenekler/güvenlik merkezi/ güvenlik merkezi ayarları/ makro ayarlarında >>"VBA projesi nesnesi mokeli erişimine güve" seçip deneyin

Kod: Tümünü seç

Sub sil()
On Error Resume Next
 
    i = 0
   
    For Each moduller In ActiveWorkbook.VBProject.VBComponents
     i = i + 1
   
     If ActiveWorkbook.VBProject.VBComponents(i).Name = "BuÇalışmaKitabı" Then
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.DeleteLines 1, _
       ThisWorkbook.VBProject.VBComponents("BuÇalışmaKitabı").CodeModule.CountOfLines
     End If
     If ActiveWorkbook.VBProject.VBComponents("Module" & i).Name <> "Module2" Then
      ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module" & i)
     
     End If
     
    Next moduller
End Sub

[sahin]

sadece sayfalar ve "module2" yedek excele kopyalanacaksa bişey silmeye gerek yok, mdule2 yedek excel dosyasına kodlar aktarılır aşağıdaki kod ile yedek dosyanın yolunu ve ismini belirleyin

Kod: Tümünü seç

Sub test()
' Dim yeniModul As VBComponent
' Dim yedek As Workbook
 On Error Resume Next
 Set yedek = Workbooks.Add
 ThisWorkbook.Sheets.Copy before:=yedek.Sheets(1)
 Set cm = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule
 kodlar = cm.Lines(1, cm.CountOfLines)
 Set yeniModul = yedek.VBProject.VBComponents.Add(vbext_ct_StdModule)
 yeniModul.CodeModule.AddFromString (kodlar)
 Application.DisplayAlerts = False
 yedek.SaveAs Filename:="D:\Kitap22.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 yedek.Close False
End Sub

Kitap1 (4).xlsm

[Beyfendi]

Üstadım çok çok teşekkür ederim. Yedekleme konusu sayende çözülmüş oldu.

sadece sayfalar ve "module2" yedek excele kopyalanacaksa bişey silmeye gerek yok, mdule2 yedek excel dosyasına kodlar aktarılır aşağıdaki kod ile yedek dosyanın yolunu ve ismini belirleyin

Kod: Tümünü seç

Sub test()
' Dim yeniModul As VBComponent
' Dim yedek As Workbook
 On Error Resume Next
 Set yedek = Workbooks.Add
 ThisWorkbook.Sheets.Copy before:=yedek.Sheets(1)
 Set cm = ThisWorkbook.VBProject.VBComponents("Module2").CodeModule
 kodlar = cm.Lines(1, cm.CountOfLines)
 Set yeniModul = yedek.VBProject.VBComponents.Add(vbext_ct_StdModule)
 yeniModul.CodeModule.AddFromString (kodlar)
 Application.DisplayAlerts = False
 yedek.SaveAs Filename:="D:\Kitap22.xlsm", _
        FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
 yedek.Close False
End Sub

Kitap1 (4).xlsm

[erseldemirel]

Bu konuya şunu ilave etmeliyim. Birden fazla excel dosyası açık olduğunda module ekleme ve silme hata verebilir. Ayrıca module üzerinde işlem yaparken vba şifreli haliyle kod çalışmayabilir. İllaki şifreyi kaldırmanız istenebilir. Kodlarınız vba şifre ile gizlenmiş ise bu kodlar çalışmayabilir

[Beyfendi]

Bu konuya şunu ilave etmeliyim. Birden fazla excel dosyası açık olduğunda module ekleme ve silme hata verebilir. Ayrıca module üzerinde işlem yaparken vba şifreli haliyle kod çalışmayabilir. İllaki şifreyi kaldırmanız istenebilir. Kodlarınız vba şifre ile gizlenmiş ise bu kodlar çalışmayabilir

Öncelikle bilgilendirme için teşekkür ederim.

Evet üstad şimdilik şifre ile kodları koruma altına almadım daha ama tasarımım bitince şifre koymayı düşünüyorum, dediğiniz gibi olacak olursa tekrar başa dönmüş olacağım, bu konuda sizin bir öneriniz olur mu üstad. Tekrar teşekkür ederim.

[erseldemirel]

Module ilgili işlemlerde vba pass engel olur kodunuza. İlk yol moduleleri ekleyip silme yapmadan kodları güncelleyeceksiniz bu module silme yöntemi kullanmayacaksınız. Diğer yol aklıma gelen araştırdım python dilinde exceli calısıtaracak kucuk scriptler yazacaksınız. Ancak buda excele hasar verebilir. Siz bir kodlarınızı oluşturuun şifre koyun ve deneyin. Nerelerde uyarı alıyorsunuz. Ayrı bir forum konusu acın yardımcı olurlar umarım bılen arkadaşlarda. Bende çözümleri duymak ısterım diğer arkadaşların. Başka çözümlerde mutlaka vardır.

Xlwings kütüphanesi ile oluşturulmus python scpiti buldum. Module siliyor vba şifreli dosyada ama denemedim.

Kod: Tümünü seç

import xlwings as xw

def main():
    wb = xw.Book(r'D:\test\dosya.xlsm')
    wb.vba_modules[0].delete()
    wb.save()
    wb.close()
if __name__ == "__main__":
    main()