Makroları kopyalamak

cengiz123 · 31 Ocak 2018

Hocam doğrudur biraz karışık oldu anlatmam.
Baştan özetleyim.

Şimdi bir excel dosyam var. Bunu programlama için kullanıyorum.bu excel dosyasının adının "programer"
Dışarda da başka klasör altında excel dosyaları var.
Program dosyasına bir buton yaptım ve dışardaki exceli, bu program için kullandığım excel dosyasının içine alıyorum
Bu dosyaya da sayfa2 adını veriyorum. Yani program ve sayfa2 adında 2 sayfa oluyor.
Sorum ise;
Sayfa2 nın kod bölümüne yükleme anında yukardaki kodlarda eklenebilir mı?

halit3 · 31 Ocak 2018

cengiz123' Alıntı:
Hocam doğrudur biraz karışık oldu anlatmam.
Baştan özetleyim.

Şimdi bir excel dosyam var. Bunu programlama için kullanıyorum.bu excel dosyasının adının "programer"
Dışarda da başka klasör altında excel dosyaları var.
Program dosyasına bir buton yaptım ve dışardaki exceli, bu program için kullandığım excel dosyasının içine alıyorum
Bu dosyaya da sayfa2 adını veriyorum. Yani program ve sayfa2 adında 2 sayfa oluyor.
Sorum ise;
Sayfa2 nın kod bölümüne yükleme anında yukardaki kodlarda eklenebilir mı?

kodlarınızı ve örnek dosyanızı açıklayıcı bilgilerle ekleyin ne yapmak istediğinizi anlayalım.

cengiz123 · 1 Şubat 2018

Halit Hocam merhaba
dosyayı yükledim.
iki excel dosyası var.
Programer dosyası makroları çalıştırdığım programlama dosyası.
dış dosya dediğim, dışarda yüklenen herhangi bir dosyadan biri.
Programer dosyasında, Modul1 in içinde Load makrosu var.
oraya kodların eklenmesini rica ediyorum.
Teşekkürler
https://www.dosyaupload.com/5f7t

halit3 · 1 Şubat 2018

Buraya yüklediğiniz dosyalar

Programer.xlsm
Dış Dosya.xlsx

Programer dosyasında Program,Sayfa2 sayfası var ve ayrıca iki adet şifreli sayfa mevcut

Dış Dosya dosyasında Sayfa1 sayfası var

Ne anladığımı söylüyorum Programer dosyasında Modüle1 deki (Load) aşağıdaki kodu Dış Dosya dosyasında Sayfa1 kod sayfasına (Load) makro kodunu eklemekmi istiyorsanuz.

Eğer öyle ise eklediğiniz kod Dış Dosya.xlsx dosyasında çalışmayacaktır çünkü xlsx usantılı dosyalara kalıcı makro eklenemeyeceği eklenen makrolar dosya açıkken çalışır dosyayı kapatınca bu makrolar silinir yada kayıt esnasında size dosyanın formatını değiştirmeniz gerektiği uyarısını verir.

Kod:

Sub Load()
Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
    dosyaload = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
    If dosyaload = "False" Then
        MsgBox "Dosya Secilmedi!"
        Sheets("Sayfa2").Select
        Sheets("Sayfa2").Range("a1").Select
        Exit Sub
    Else
        vfilename = Split(dosyaload, "\")
        sFile = vfilename(UBound(vfilename))
        Application.Workbooks.Open Filename:=dosyaload
           Set wbBk = Workbooks(sFile)
           With wbBk
                Set wsSht = .Sheets(1)
                ActiveSheet.Name = "Sayfa2x"
                wsSht.Copy After:=sThisBk.Sheets(ThisWorkbook.Worksheets.Count)
                    wbBk.Close SaveChanges:=False
        End With
        Sheets("Program").Select
        Sheets("Sayfa2").Delete
        Sheets("Sayfa2x").Name = "Sayfa2"
    End If
    
    
    
    
' Makro kodlarını kopyalayacak kodların yüklenmesini istediğim yer burasıdır.
'Makro Kodlarını Program sayfasından A1 hücresinden çekecektir.
    
    
    
    
Sheets("Sayfa2").Select
Sheets("Sayfa2").Range("a1").Select
End Sub

cengiz123 · 1 Şubat 2018

merhaba Halit Bey,
Programer çalışma kitabında, Sayfa2 var.
dışardan yükleme yapılan değişik dosyalar var.
size gönderdiğim örnek Dış Dosya var.
bu dosyayı yüklerken Parogramer çalışma kitabının içine alınca eski sayfa2'yi silip yeni yükleneni(dış dosya) buraya ekliyor. ismini de tekrar Sayfa2 yapıyor.
eski sayfa2 silindiği için kod bölümündeki kodlar silinmiş oluyor.
bundan dolayı tekrar buraya kodla yazdırmak istiyorum.
onu da yüklemem anında yapmak istiyorum. o yüzden gösterdiğim bölüme kodları eklenmesini istemiştim.

cengiz123 · 1 Şubat 2018

ayrıca dediğiniz gibi sadece programer içinde bu kodlar çalışacak. dışardan yüklediğim dosyay işlem gördükten sonra tekrar xlsx olarak farklı kaydedilecektir.

halit3 · 1 Şubat 2018

Sorunuzu bir gözden geçirin sadece kendiniz anlayabiliyorsunuz .

Ben sorunuz şimdi anladım

Program dosyasındaki kodların bulunduğu modül sayfası (Sayfa2) deki kodu yeni oluşturulan aktif sayfadaki (Sayfa2x değişmemiş hali) sayfasının modül koduna yapıştırmak

kod:

Kod:

Sub makro_kopyala()

kodcopy = "Sayfa2" 'Modul sayfa adı
kodpasta = "Sayfa2" ' Aktif sayfa adı

For Each ModX In ActiveWorkbook.VBProject.VBComponents
If kodcopy = ModX.Name Then
Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(kodcopy).CodeModule
yaz = ""
For i = 1 To VBCodeMod.CountOfLines
deg1 = ThisWorkbook.VBProject.VBComponents(kodcopy).CodeModule.Lines(i, 1)
If deg1 <> "" Then
yaz = yaz & deg1 & Chr(13)
End If
Next
GoTo atla
End If
Next

Exit Sub

atla:


For n = 1 To ActiveWorkbook.Sheets.Count
If kodpasta = Worksheets(n).Name Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(Worksheets(n).CodeName).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
deg6 = ActiveWorkbook.VBProject.VBComponents(Worksheets(n).CodeName).CodeModule
ActiveWorkbook.VBProject.VBComponents(deg6).CodeModule.InsertLines 1, yaz
End If
Next

End Sub

Not: Genelde modüldeki kodları başka dosyalara kopyalamak için kullanılır eğer sayfadaki kodları başka sayfadada kullanılacaksa bu işlemlere gerek kalmadan ThisWorkbook kod bölümüne yazmak yeterlidir.

halit3 · 1 Şubat 2018

BuÇalışmaKitabı veya ThisWorkbook kod sayfasına şöyle bir şey yapsan da olur. Kırmızı sayfalar dışında kod çalışmayacaktır.

Kod:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
sayfa = ActiveSheet.Name

If sayfa = "[COLOR="Red"]Sayfa2[/COLOR]" Or sayfa = "[COLOR="red"]Sayfa3[/COLOR]" Or sayfa = "[COLOR="red"]Sayfa4[/COLOR]" Then

Else
MsgBox "sayfa yok"
Exit Sub
End If

BuÇalışmaKitabı.Activate

If Target.Column = 4 Then
If Target.Cells.Offset(0, -2) Like "*KONTROL*" And Target.Cells.Offset(0, -2) Like "*SORUMLU*" Then
Sheets("Form").Range("d11").Copy
Sheets("Pivot").Range("x3").PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks:=False, Transpose:=False
Application.CutCopyMode = False
End If
End If

If Target.Column = 4 Then
If Len(Target.Cells) = 32 And Target.Cells.Offset(0, -2) Like "*BARKOD*" Then
Target.Cells.Offset(0, 2) = "    " & Date & "    " & Time
Target.Cells.Offset(0, 5) = "                     " & Sheets("Pivot").Range("x3")
ElseIf Len(Target.Cells) < 32 And Len(Target.Cells) >= 0 And Target.Cells.Offset(0, -2) Like "*BARKOD*" Then:
Target.Cells.ClearContents
Target.Cells.Offset(0, 2).ClearContents
Target.Cells.Offset(0, 5).ClearContents

ElseIf Len(Target.Cells) > 32 And Len(Target.Cells) < 64 And Target.Cells.Offset(0, -2) Like "*BARKOD*" Then:
Target.Cells.ClearContents
Target.Cells.Offset(0, 2).ClearContents
Target.Cells.Offset(0, 5).ClearContents
End If
End If

If Target.Column = 4 Then
If Len(Target.Cells) < 20 And Len(Target.Cells) >= 0 And Target.Cells.Offset(0, -2) Like "*SERİ NO*" Then
Target.Cells.ClearContents
ElseIf Len(Target.Cells) > 20 And Len(Target.Cells) < 40 And Target.Cells.Offset(0, -2) Like "*SERİ NO*" Then:
Target.Cells.ClearContents
End If
End If
End Sub

cengiz123 · 1 Şubat 2018

merhaba Halit hocam,

çok teşekkür ederim.
bu özelliği bilmiyordum.
peki sayfa2 de,

Private Sub Commandbutton_1()
Load
End Sub

olsaydı, bu özelliği yeni yüklenen sayfa için nasıl kullanırdık.

kusura bakmayın çok soru sordum.

halit3 · 1 Şubat 2018

BuÇalışmaKitabı kod bölümüne bu kodu kopyala

Kod:

Private Sub Workbook_Open()
BuÇalışmaKitabı.formac
End Sub


Sub formac()

Application.ScreenUpdating = False
Application.DisplayAlerts = False
Set sThisBk = ActiveWorkbook
dosyaload = Application.GetOpenFilename(FileFilter:="Microsoft Excel Workbooks, *.xls; *.xlsx", Title:="Open Workbook")
MsgBox 1

If dosyaload = "False" Then
MsgBox "Dosya Secilmedi!"
Sheets("Sayfa2").Select
Sheets("Sayfa2").Range("a1").Select
Exit Sub
Else
MsgBox 2
vfilename = Split(dosyaload, "\")
sFile = vfilename(UBound(vfilename))
Application.Workbooks.Open Filename:=dosyaload
Set wbBk = Workbooks(sFile)
With wbBk
MsgBox 3
Set wsSht = .Sheets(1)
ActiveSheet.Name = "Sayfa2x"
MsgBox 4
wsSht.Copy After:=sThisBk.Sheets(ThisWorkbook.Worksheets.Count)
'wbBk.Close SaveChanges:=False
MsgBox 5
End With
Sheets("Program").Select
MsgBox 6
Sheets("Sayfa2").Delete
MsgBox 7
Sheets("Sayfa2x").Name = "Sayfa2"
MsgBox 8
End If
' Makro kodlarını kopyalayacak kodların yüklenmesini istediğim yer burasıdır.
'Makro Kodlarını Program sayfasından A1 hücresinden çekecektir.
Sheets("Sayfa2").Select
Sheets("Sayfa2").Range("a1").Select
End Sub

cengiz123 · 1 Şubat 2018

halit hocam merhaba
kusura bakmayın. denedim ama olmadı. yani benim aradığım,
Program sayfasının A1 hücresindeki kodları, sayfa2 nin kod bölümüne yazması.
bu şekilde olmaz mı peki

halit3 · 1 Şubat 2018

halit hocam merhaba
kusura bakmayın. denedim ama olmadı. yani benim aradığım,
Program sayfasının A1 hücresindeki kodları, sayfa2 nin kod bölümüne yazması.
bu şekilde olmaz mı peki

Siz her seferinde sorunuzu değiştiriyorsunuz.
İnşallah bu sefer olur.

Kod:

Sub [COLOR="Red"]makro_kopyala2[/COLOR]()

kodcopy = "Program" 'kodun bulunduğu sayfa
kodpasta = "Sayfa2" ' yazılacak sayfa adı

For n = 1 To ActiveWorkbook.Sheets.Count
If kodpasta = Worksheets(n).Name Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(Worksheets(n).CodeName).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
deg6 = ActiveWorkbook.VBProject.VBComponents(Worksheets(n).CodeName).CodeModule
ActiveWorkbook.VBProject.VBComponents.Item(deg6).CodeModule.InsertLines 1, Sheets(kodcopy).Cells(1, 1).Value
Exit For
End If
Next

End Sub

cengiz123 · 1 Şubat 2018

merhaba Halit hocam,
aslında ben bunu soruyordum.
kendimi anlatamadım.
sizin kodu bir modüle kopyaladım ve çalıştırdım.
şöyle bir hata verdi.
Run time error '1004':
Visual Basic Projesine programlı olarak erişim güvenli değil.

halit3 · 1 Şubat 2018

Birde bu kodu dene

Kod:

Sub makro_kopyala()

kodcopy = "Program" 'kodun bulunduğu sayfa
kodpasta = "Sayfa2" ' yazılacak sayfa adı


yaz = ""
For i = 1 To Sheets(kodcopy).Cells(Columns.Count, "A").End(3).Row
deg1 = Sheets(kodcopy).Cells(i, 1).Value
If deg1 <> "" Then
yaz = yaz & deg1 & Chr(13)
End If
Next

For n = 1 To ActiveWorkbook.Sheets.Count
If kodpasta = Worksheets(n).Name Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(Worksheets(kodpasta).CodeName).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
End If
Next


deg4 = ActiveWorkbook.VBProject.VBComponents(Worksheets(kodpasta).CodeName).CodeModule
ActiveWorkbook.VBProject.VBComponents.Item(deg4).CodeModule.InsertLines 1, yaz

End Sub

halit3 · 1 Şubat 2018

Bu kod daha kısa

Kod:

Sub makro_kopyala()

kodcopy = "Program" 'kodun bulunduğu sayfa
kodpasta = "Sayfa2" ' yazılacak sayfa adı

yaz = ""
For i = 1 To Sheets(kodcopy).Cells(Columns.Count, "A").End(3).Row
deg1 = Sheets(kodcopy).Cells(i, 1).Value
If deg1 <> "" Then
yaz = yaz & deg1 & Chr(13)
End If
Next

For n = 1 To ActiveWorkbook.Sheets.Count
If kodpasta = Worksheets(n).Name Then
Set VBCodeMod = ActiveWorkbook.VBProject.VBComponents(Worksheets(kodpasta).CodeName).CodeModule
VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
VBCodeMod.InsertLines 1, yaz
Exit For
End If
Next
End Sub

cengiz123 · 1 Şubat 2018

Halit bey teşekkür ederim.
don iki makronuzu denedim aynı hatayı veriyor.
dosyam ektedir.
nerde hata yapıyorum bakabilir misiniz.

https://www.dosyaupload.com/5fdd

halit3 · 1 Şubat 2018

http://www.excel.web.tr/f157/ofis-2003-u-ilk-kullananlar-icin-makro-guvenlik-t104854.html
http://www.excel.web.tr/f157/ofis-2007-yi-ilk-kullananlar-icin-makro-guvenlik-t104852.html

http://www.excel.web.tr/f157/office-2007de-makro-guvenlik-ayarlaryny-du-urmek-resimli-t83371.html

bu linkleri irdeleyiniz.

Verdiğiniz linkdeki dosya inmiyor hata veriyor

cengiz123 · 2 Şubat 2018

Halit Hocam merhaba
dediğiniz gibi, excel engelliyormuş.
VBA Projesi nesne modeli erişimine güven işaretli değilmiş bende.

son göndermiş olduğunuz kodu denedim. tam istediğim gibi.
allah razı olsun.
2 gündür çok uğraştırdım sizi.
ne kdar teşekkür etsem az

halit3 · 2 Şubat 2018

cengiz123' Alıntı:
Halit Hocam merhaba
dediğiniz gibi, excel engelliyormuş.
VBA Projesi nesne modeli erişimine güven işaretli değilmiş bende.

son göndermiş olduğunuz kodu denedim. tam istediğim gibi.
allah razı olsun.
2 gündür çok uğraştırdım sizi.
ne kdar teşekkür etsem az

Evet çok basit gibi görünüyor konu ama bu mesajımla 39 mesaj etmiş

Size iyi çalışmalar diliyorum.

tamermaster · 8 Şubat 2020

Sayfanın kod bölümü yerine modüle nasıl ekleriz ?
Module1 yada Module2 ye eklersek ne yapmamız gerekir ?
Aslında UserForm'a ekleyeceğim ama modüle eklemekte bana faydalı olur.
UsreForm içinden Modülü çağırarak yapabilirim.
Şimdiden teşekkürler..

Makroları kopyalamak

cengiz123

halit3

Uzman

cengiz123

halit3

Uzman

cengiz123

cengiz123

halit3

Uzman

halit3

Uzman

cengiz123

halit3

Uzman

cengiz123

halit3

Uzman

cengiz123

halit3

Uzman

halit3

Uzman

cengiz123

halit3

Uzman

cengiz123

halit3

Uzman

tamermaster