Vba kırmaya engel

[cocoa35]

Arkadaşlar aşağıdaki kod'lar vba şifresi olmayan bir dosyanın yeri değiştiğinde otomatik olarak "makro" ları siliyor;
örnek 1
Private Sub Workbook_Open()
If ThisWorkbook.Path <> "C:\\user\makro" Then
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End Select
Next VBComp
ActiveWorkbook.Save
ActiveWorkbook.Close
End If

Ancak vba şifresi konulduğunda veya aşağıdaki gibi değiştirdiğimde çalışmıyor örneğin bu kod'u aşağıdaki gibi çevirdiğimde çalışmıyor.
örnek2
Private Sub Workbook_Open()
If ThisWorkbook.VBProject.Protection <> "123" Then
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End Select
Next VBComp
ActiveWorkbook.Save
ActiveWorkbook.Close
End If
End Sub

yukardaki kodların vba şifresi değiştiği anda çalışır duruma nasıl getirebiliriz.

 

[uzmanamele]

merhaba

alternatif yöntem işinizi görür mü?

Sub koruma()
If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then Exit Sub
MsgBox "koruma yok, kodları sil"
End Sub

eğer dosyanıza vba şifresi koymuşsanız, vba editörüne girmek için bir şekilde şifreyi açmak gerekecektir.
kendiniz vba editöründe değişiklik yapacaksanız, makroları etkinleştirmeden dosyayı açar sonra düzeltme yaparsınız.
başkası makroları etkinleştirerek dosyayı açıp vba şifresini yazarak editöre girerse koruma olmadığından kod tetiklenir ve tüm makroları silebilirsiniz.

bu kodu tetiklemek için nereye nasıl yazmak gerekir siz bir araştırın, bulduğunuz çözümü paylaşırsanız memnun oluruz.

 

[cocoa35]

Sn uzmanamele;
alternatif çözümünüz için tşk ederim ama ben onu anlıyamadım vba şifresi koyup sonra onu kırdığımda herhangi bir makro silmesi olmadı...

 

[uzmanamele]

merhaba

bunu deneyiniz.

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
If ThisWorkbook.VBProject.Protection = vbext_pp_locked Then Exit Sub
For Each VBComp In ActiveWorkbook.VBProject.VBComponents
Select Case VBComp.Type
Case 100
With VBComp.CodeModule
.DeleteLines 1, .CountOfLines
End With
Case Else
ActiveWorkbook.VBProject.VBComponents.Remove VBComp
End Select
Next VBComp
ActiveWorkbook.Save
ActiveWorkbook.Close
End Sub