Personel & Zimmet Takip Programı (KZT-v.5) foruma eklenmiştir. 
http://www.excelce.net/forum/index.php?topic=1676.0

Gönderen Konu: Macrolarımı otomatik diğer kitaplara aktarma ve sayfa kopyalama ve vba şifre koy  (Okunma sayısı 6162 defa)

0 Üye ve 1 Ziyaretçi konuyu incelemekte.

Çevrimdışı a_self_lion

  • Excelce Onbaşı
  • **
  • İleti: 13
  • Puan +0/-0
  • Excel'den Daha Fazlası!..
  • Ad Soyad: özcan özarslan
  • İl / İlçe: antalya
  • Mesleğiniz: bilgi işlem
Sayın Husgvarna nin vermiş olduğu kodlar aşağıdadır.

Araçlar/Makro/güvenlik/Güvenilen yayımcılar/Visual basic erişimine güven kutusu işaretli olmalı

 
Kod: [Seç]
Dim ds, dc, f, s
Dim AA As Workbook
Dim BB As Workbook
Dim CC As String
Dim DestCom As Object
Dim DestMod As Object
With ThisWorkbook
        .VBProject.VBComponents("Module1").Export (ThisWorkbook.Path & "\Module1.bas")
        .VBProject.VBComponents("Module2").Export (ThisWorkbook.Path & "\Module2.bas")
        .VBProject.VBComponents("UserForm1").Export (ThisWorkbook.Path & "\UserForm1.frm")
    End With
Set ds = CreateObject("Scripting.FileSystemObject")
Set f = ds.GetFolder(ThisWorkbook.Path & "\Y\")
Set dc = f.Files
For Each Dosya In dc
MB = ThisWorkbook.Path & "\Y\" & Dosya.Name
Set ML = New Excel.Application
ML.Workbooks.Open MB
 ML.Workbooks(Dir(MB)).VBProject.VBComponents.Import (ThisWorkbook.Path & "\Module1.bas")
  ML.Workbooks(Dir(MB)).VBProject.VBComponents.Import (ThisWorkbook.Path & "\Module2.bas")
   ML.Workbooks(Dir(MB)).VBProject.VBComponents.Import (ThisWorkbook.Path & "\Userform1.frm")
   
    ML.Workbooks(Dir(MB)).Worksheets.Add
       ML.Workbooks(Dir(MB)).ActiveSheet.Name = "TANIMLAR"
' ASLINDA TANIMLAR DOSYASINI EKLEMEK YERİNE BENDE OLANI O KİTAPLARA KOPYALAMAK İSTİYORUM.   
 
 ML.Workbooks(Dir(MB)).Worksheets.Add
       ML.Workbooks(Dir(MB)).ActiveSheet.Name = "GECIS"
'GECIS SAYFASI GİZLİ OLARAK AÇILACAK
 
 
For x = 1 To ThisWorkbook.Sheets.Count
On Error Resume Next
    Set AA = ThisWorkbook
    Set BB = ML.Workbooks(Dir(MB))
    With AA.VBProject.VBComponents("Sayfa" & x).CodeModule
        CC = .Lines(1, .CountOfLines)
    End With
    Set DestCom = BB.VBProject.VBComponents("Sayfa" & x)
    Set DestMod = DestCom.CodeModule
    With DestMod
        .DeleteLines 1, .CountOfLines
        .AddFromString CC
    End With
        With AA.VBProject.VBComponents("ThisWorkbook").CodeModule
        CC = .Lines(1, .CountOfLines)
    End With
    Set DestCom = BB.VBProject.VBComponents("ThisWorkbook")
    Set DestMod = DestCom.CodeModule
    With DestMod
        .DeleteLines 1, .CountOfLines
        .AddFromString CC
    End With
    Next
ML.Workbooks(Dir(MB)).Close Save = False
ML.Quit
Set ML = Nothing
Next
 Kill ThisWorkbook.Path & "\Module1.bas"
 Kill ThisWorkbook.Path & "\Module2.bas"
   Kill ThisWorkbook.Path & "\Userform1.frm"
   Kill ThisWorkbook.Path & "\Userform1.frx"
Ben kendime göre bu kodları düzenledim TANIMLAR VE GECIS Diye bir dosya ekletebiliyorum. Benim istediğim burada bir kaç şey daha var.

1- TANIMLAR sayfasını Setup olarak kullandığım ve bu kodları diğerlerine aktardığım dosyada var onu olduğu gibi diğer kitaplara kopyalamak istiyorum.
2- GECIS adında eklemiş olduğum sayfamın gizli olmasını istiyorum.
3- Setup olarak kullandığım kitabım da ki kodlar vba Project’im şifreli doğal olarak kopyalama yapmak istediğinde hata veriyor önce şifreyi kaldırıp kopyaladıktan sonra tekrar şifre koymak istiyorum.
4- Ve diğer kopyaladığı çalışma kitaplarıma da vba project şifresini koymasını istiyorum.
5- Bir kere çalıştırdıktan sonra kodlar hatasız çalışıyor ikinci çalıştırışımda
Kod: [Seç]
ML.Workbooks(Dir(MB)).VBProject.VBComponents.Impor t (ThisWorkbook.Path & "\Userform1.frm")burda hata veriyor. Sanırım bu aynı şeyler olduğu için yapıyor bunun kontrolünü nasıl yapabilirim.

Yardımcı olacak arkadaşlara şimdiden teşekkür ederim.