• DİKKAT

    DOSYA İndirmek/Yüklemek için ÜCRETLİ ALTIN ÜYELİK Gereklidir!
    Altın Üyelik Hakkında Bilgi

Modüle kod ekleme - değiştirme silme vb.

N

netcini

Katılım
9 Mayıs 2008
Mesajlar
48
Excel Vers. ve Dili
Excel 2010/2013 TR
Merhabalar.

Makro yardımı ile varolan makroların kodlarında ekleme değişiklik vb yapmak istiyorum.

Elimde makrolu olan 300-400 civarı excel dosyası var.

Makro ile grafik çizimi yaptırıyorum. Ama bu dosyalarda ek bazı işlemler daha yaptırmam lazım. Hazırladığım kodu bütün dosyaları tek tek açıp modullere yapıştırmak epey uzun ve zahmetli olacak..

Açık olan dosyaların atıyorum modul5 isimli modülünün en sonuna makro kodlarını ekleyebilmem için yardımcı olabilir misiniz.

Hatta atıyorum modul5 teki dosyaac isimli makroyu silip yerine düzeltme yaptığım dosyaac isimli makroyu ekleyebilecek şekilde kodlama yapan bir makro olursa oda iyi olur.

Elinizde örnekde varsa örnekten kendime göre uyarlama yapabilirim.

Şimdiden teşekkürler.
 
iyi çalışmalar
 
Hocam Allah razı olsun sizin çalışmalarınızdan referans alarak sorunu çözdüm.

Yalnız benim var olan kitaptaki modüllere değilde başka modüllere kod eklemem gerektiği için daha önce elimde olan dosya açıp grafik verilerine yeni veriler ekleyip katapan makromdan alıntı yapmam gerekti. (O kodları da başka yerden alıp düzenleme yapmıştım)

Kod yazdırma sorununu hallettikten sonra beni en çok uğraştıran konu ekleme yapacağım vba projelerinin şifre korumalı olmasıydı. Onu da bulduğum bir kodda bazı değişiklikler yaparak çözdüm.

Başka birisinin işiniede yarayabileceğini düşünerek kodları buraya ekliyeyim dedim.

Makroyu çalıştırmak için kodları eklediğimiz kitapta bir buton oluşturup Aktar makrosunu çalıştıracak şekilde ayarlıyoruz.
Kitabın A1 hücresine ekleyeceğimiz kodu yazıyoruz. (Çoklu satır ekleyeceksek Alt+Enter yaptıktan sonra diğer satıra başlamalıyız)

Daha sonra ekleme yapılacak kitapların bulunduğu klasörü Dosya aç menüsünden açıp çıkıyoruz. Bunun nedeni makronun en son açılmış olan klasörde işlem yapmasıdır.
Makroyu çalıştırdığımız zaman açtığımız dizinde bulunan bütün dosyaları sırasıyla açıyor kodu ekliyor ve kaydedip kapatıyor.



Global snextFile, files(50) As String
Global x(4), y, z, k, t, j As Integer
Global kod

Sub AKTAR()
Application.ScreenUpdating = False

'------
Range("A1").Select
kod = Cells(1, 1)
j = 0
snextFile = ""
snextFile = Dir$("*.XLS")
While snextFile <> ""
j = j + 1
files(j) = snextFile
snextFile = Dir$
Wend
'-----
For y = 1 To j
For z = 1 To j
If files(z) < files(y) Then
temp = files(z)
temp1 = files(y)
files(z) = temp1
files(y) = temp
End If
Next z
Next y
'-----
While j > 0
snextFile = files(j)
Workbooks.Open Filename:= _
snextFile
koruma_ac
Range("A1").Select
j = j - 1
Wend
Application.ScreenUpdating = True
End Sub

Sub koruma_ac()
UnprotectVBProject Workbooks(snextFile), "sifre" ' sifre yerine vba projesinin şifresi girilmeli
Workbooks(snextFile).Activate
ActiveWorkbook.VBProject.VBComponents("Buraya Modül İsmi Yazılacak").CodeModule.InsertLines 1, kod
ActiveWorkbook.Save
ActiveWindow.Close
End Sub


Sub UnprotectVBProject(WB As Workbook, ByVal Password As String)

Dim VBP As VBProject, oWin As VBIDE.Window
Dim wbActive As Workbook
Dim i As Integer

Set VBP = WB.VBProject
Set wbActive = ActiveWorkbook

If VBP.Protection <> vbext_pp_locked Then Exit Sub

'Application.ScreenUpdating = False

' Close any code windows To ensure we hit the right project
For Each oWin In VBP.VBE.Windows
If InStr(oWin.Caption, "(") > 0 Then oWin.Close
Next oWin

WB.Activate
' now use lovely SendKeys To unprotect
Application.OnKey "%{F11}"
SendKeys "%{F11}%TE" & Password & "~~%{F11}", True

'If VBP.Protection = vbext_pp_locked Then
' failed - maybe wrong password
'SendKeys "%{F11}%TE", True
'End If

' leave no evidence of the password
'Password = ""
' go back To the previously active workbook
wbActive.Activate

End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Geri
Üst