Makro ile sayfaya ait kodları silmek

[Korhan Ayhan]

Selamlar,

Arkadaşlar arama yaparak aşağıdaki kodu buldum bu kod çalışmadaki Modül1 i siliyor fakat aktif sayfaya ait kodları silmek istersek nasıl değiştirmemiz gerekir.

ActiveWorkbook.VBProject.VBComponents.Remove ActiveWorkbook.VBProject.VBComponents("Module1")

 

[Korhan Ayhan]

Selamlar,

Arkadaşlar konu ile ilgili fikri olan yok mu ?

 

[Ali]

Sn COST_CONTROL, sizin mesajınızdan sonra İngilizce forumları gezdim.Şunları buldum

Belki faydası olur.

Not: Bu macronun çalışması için Microsoft Visual Basic For Applications Extensibility etkin hale getirdikten sonra aşağıdaki kodları çalıştırın.

Bir çalışma kitabındaki tüm modülleri silmek için

Sub DeleteModule()
Dim VBComp As VBComponent
Set VBComp = ThisWorkbook.VBProject.VBComponents("NewModule")
ThisWorkbook.VBProject.VBComponents.Remove VBComp
End Sub

Bir modüldeki prosedürleri silmek için

Sub DeleteProcedure()

Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long

Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
With VBCodeMod
    StartLine = .ProcStartLine("MyNewProcedure", vbext_pk_Proc)
    HowManyLines = .ProcCountLines("MyNewProcedure", vbext_pk_Proc)
    .DeleteLines StartLine, HowManyLines
End With

End Sub

Bir modüldeki tüm kodları silmek için

Sub DeleteAllCodeInModule()
Dim VBCodeMod As CodeModule
Dim StartLine As Long
Dim HowManyLines As Long

Set VBCodeMod = ThisWorkbook.VBProject.VBComponents("NewModule").CodeModule
With VBCodeMod
    StartLine = 1
    HowManyLines = .CountOfLines
   .DeleteLines StartLine, HowManyLines
End With

End Sub

Bir projede tüm kodları, (modül,classmodüle,userform,sayfa modülleri ve thisworbookta kodları silmek için)

Sub DeleteAllVBA()

Dim VBComp As VBIDE.VBComponent
Dim VBComps As VBIDE.VBComponents

Set VBComps = ActiveWorkbook.VBProject.VBComponents

For Each VBComp In VBComps
   Select Case VBComp.Type
      Case vbext_ct_StdModule, vbext_ct_MSForm, _
            vbext_ct_ClassModule
         VBComps.Remove VBComp
      Case Else
         With VBComp.CodeModule
            .DeleteLines 1, .CountOfLines
         End With
   End Select
Next VBComp

End Sub

 

[Korhan Ayhan]

Selamlar,

Sn. fructose ilginiz için teşekkür ederim son önerdiğiniz kod işime yarayacak gibi bu kodu yalnız ilk sayfa hariç diğer sayfalardaki kodları silecek şekilde nasıl ayarlayabiliriz. :hey:

 

[Haluk]

...
sizin mesajınızdan sonra İngilizce forumları gezdim.Şunları buldum
....

Ben de bizim forumda şunu buldum... :mrgreen:

http://www.excel.web.tr/viewtopic.php?t=2370

 

[Korhan Ayhan]

Selamlar,

Haluk bey ilginiz için teşekkür ederim linki inceledim fakat aşağıdaki koda nasıl uyarlayabiliriz. Amacım sayfayı kopyaladıktan sonra yeni sayfadaki kodları silebilmek.

Private Sub Worksheet_Change(ByVal Target As Range)
Application.ScreenUpdating = False
On Error GoTo HATA
Set S1 = Sheets("FORM")
If Target.Address <> "$AP$6" Then Exit Sub
If S1.[AP6] <> "" Then
Sheets.Copy After:=Worksheets(Worksheets.Count)
ActiveSheet.Name = S1.[AP6].Value
ActiveSheet.[A1].Select
S1.Select
[A1:AP48].ClearContents
Target.Select
End If
Exit Sub
HATA:
Application.DisplayAlerts = False
ActiveSheet.Delete
Application.DisplayAlerts = True
S1.Select
Target.Select
MsgBox "Aynı isimde sayfa mevcuttur." _
& Chr(10) & Chr(10) & "Lütfen girdiğiniz bilgileri kontrol ediniz.", vbExclamation, "Dikkat !"
Application.ScreenUpdating = True
End Sub

 

[Ali]

Sub Makrolarıkaldır(objDocument As Object)
Dim i As Long, l As Long
    If objDocument Is Nothing Then Exit Sub
    i = 0
    On Error Resume Next
    i = objDocument.VBProject.VBComponents.Count
    On Error GoTo 0
    If i < 1 Then ' Hiçbir VBA komponenti yok yada korumalı
        MsgBox " VBProject  " & objDocument.Name & _
            " korumalı yada hiçbir komponent yok", _
            vbInformation, "Tüm makroları kaldır"
        Exit Sub
    End If
    With objDocument.VBProject
        For i = .VBComponents.Count To 1 Step -1
            On Error Resume Next
            .VBComponents.Remove .VBComponents(i)
            ' Bileşenler siliniyor
            On Error GoTo 0
        Next i
    End With
    With objDocument.VBProject
        For i = .VBComponents.Count To 1 Step -1
            l = 1
            On Error Resume Next
            l = .VBComponents(i).CodeModule.CountOfLines
            .VBComponents(i).CodeModule.DeleteLines 1, l
            ' temizleniyor
            On Error GoTo 0
        Next i
    End With
End Sub

 

[Haluk]

Aktif sayfaya ait modül kodlarını siler;

Sub Test()
    Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ActiveSheet.Name).CodeModule
    VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
End Sub

1nci sayfa hariç, diğer tüm sayfalara ait modül kodlarını siler;

Sub Test2()
    For i = 2 To Sheets.Count
        Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(Sheets(i).Name).CodeModule
        VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
    Next
End Sub

 

[Ali]

Sn Haluk dün bir kod buldum İngilizce forum sayfalarda birde baktımki Haluk Bey'in kodları avatarda aynı yani tam kendisi kodlar havada uçuşuyor oradada, artık uluslararası olmuşsunuz :mrgreen:

Çeviri yapmıştım ingilizceden bir hatamı düzelteyim sanırım Excel 2000 ve sonrası bu Microsoft Visual Basic For Applications Extensibility etkin olması için Araçlar-Makro-Güvenlik kısmından Güvenilir kaynakları kısmından Visual Basic Project erişimine güven kısmının seçili olması gerekiyor.

Bu sefer çeviriyi tam yaptım.

Sorunuzla farklı şeyler öğrenmeme sebep olduğunuz için Sn COST CONTROL ve Haluk Beye teşekkürler

 

[Haluk]

.....
, artık uluslararası olmuşsunuz :mrgreen:
....

Eyvallah ... :mrgreen:

Bu arada; eğer aktif sayfanın adı ile aktif sayfanın kod modül adı birbiriyle aynı değilse ve kullanacağımız kodda ne aktif sayfa adı, ne de aktif sayfanın kod modül adını referans vermek istemiyorsak;

Sub Test3()
    Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ActiveSheet.Index + 1).CodeModule
    VBCodeMod.DeleteLines 1, VBCodeMod.CountOfLines
End Sub

 

[Korhan Ayhan]

Selamlar,

Arkadaşlar ilginiz için çok teşekkür ederim. :hey:

 

[baydeniro]

Paylaşım İçin Teşekkürler

Sayın üstatlar katkılarınız için önünüzde saygı ile eğiliyorum. Sağolun, var olun. Sizler gibi vatan evlatları oldukça TÜRKİYE CUMHURİYETİ daima muzaffer olacaktır. Sizleri gördükçe moralim katlanıyor.

 

[Mahmut Kök]

"fructose kim? Ben Ali olarak g&#246;r&#252;yorum." demi&#351;tim. Say&#305;n Ali'nin daha &#246;nce kulland&#305;&#287;&#305; kullan&#305;c&#305; ad&#305; imi&#351; galiba. E, neresinden d&#246;nersek k&#226;r! Tebrikler say&#305;n Ali.


Kodlar i&#231;in te&#351;ekk&#252;rler..

 

[Leoncio]

Merhaba;

Not: Bu macronun çalışması için Microsoft Visual Basic For Applications Extensibility etkin hale getirdikten sonra aşağıdaki kodları çalıştırın.

Nasıl etkin hale getirebiliriz.

 

[hakki220]

nesne sil

access te olsa nesne sil makrosu ile kolaylıkla yapılırdı herhalde ama

belirli tarih nasıl olurdu acaba