Çalışma kitabı açılırken VBA proje şifresini kaldırmak

K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Sayın hocalarım, değerli arkadaşlar
Aşağıdaki kodla ( formlardan buldum ) zamanı gelince, kitaptaki tüm modül, userform, ve sayfalardaki kodları siliyorum. (Bu kodları daha önce bu forma göndermiştim)
Kod: 
Private Sub modsil3()
Dim vbComps As Object, vbcomp As Object
Dim y As Integer
If CDbl(Date) > CDbl(CDate(("01.03.2012"))) Then
    'aşağıdaki 5 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğini işaretleyip false ediyor
    Dim WSH_Shell As Object, MyVer As String, RegKey As String, MySetting As Integer
    MyVer = Application.Version
    RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegWrite RegKey, 1, "REG_DWORD"
    'Aşagıdaki 12 satır silici
                Set vbComps = ActiveWorkbook.VBProject.VBComponents
                For Each vbcomp In vbComps
                    Select Case vbcomp.Type
                        Case 100
                            With vbcomp.CodeModule
                               If vbcomp.Name <> "ThisWorkbook" Then .DeleteLines 1, .CountOfLines
                            End With
                        Case Else
                            vbComps.Remove vbcomp
                    End Select
                Next vbcomp
                Set vbComps = Nothing
    'aşağıdaki 4 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğini işareti kaldırıp true ediyor
    MyVer = Application.Version
    RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegDelete RegKey

End If
End Sub
Fakat proje parola korumalı olduğunda, hata verip hiç birşey silmiyor.
Sizlerden ricam, kitap açılırken kendi yazdığım VBA proje şifresini kaldıracak bir kod. İşlem bitince tekrar aynı parolayı verip kaydetmesi gerekiyor
Hepinize teşekkürler , kolay gelsin
 
K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Sayın Levent Menteşoğlu çok teşekkürler. Kendi kodlarıma uyarlamaya çalışacağım. Yapamazsam sizleri tekrar rahatsız ederim.
 
K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Levent Bey, çalışma kitabının ThisWorkbook 'a auto_open olayına Application.Run "sifrekaldir" yazdım. Sizin yazdığınız modül içindeki "auto_open" makrosunu kapattım . Şimdi kitap açılırken şifre soran userform çıkmıyor ama VBA şifresini soran ekran çıkıyor. Doğru şifreyi yazınca VBA project, project properties ekranı çıkıyor. Bunu önlemenin yolu var mı?
 
K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Sayın Levent Menteşoğlu
Kod: 
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute[code]
kod satırını kapatınca VBA project, project properties ekranı  artık gelmez oldu. VBA şifresini soran ekran DisplayAllerti False yaptığım halde yine geliyor.
 
L

Levent Menteşoğlu

Administrator
Yönetici
Admin
Katılım
13 Ekim 2004
Mesajlar
16,057
Excel Vers. ve Dili
Excel 2010-32 bit-Türkçe
Excel 365 -32 bit-Türkçe
VB editörü şifresini açıp kodları silmek kolay ancak tekrar kaydetmek zor. Çünkü kayıt edecek kodlarda silinmiş olacak. Buna bir çözüm bulabilirseniz aşağıdaki kodlara ilave edebilirsiniz.

Kod: 
Sub sifrekaldirma()
projesifrekaldir Workbooks(ThisWorkbook.Name), "şifre"
Application.Wait Now + TimeValue("00:00:01")
modsil3
End Sub

Sub projesifrekaldir(dosya As Workbook, ByVal sifre As String)
Dim Proje As Object
Set Proje = dosya.VBProject
If Proje.Protection <> 1 Then Exit Sub
Set Application.VBE.ActiveVBProject = Proje
SendKeys sifre & "~~"
Application.VBE.CommandBars(1).FindControl(ID:=2578, recursive:=True).Execute
End Sub

Private Sub modsil3()
Dim vbComps As Object, vbcomp As Object
Dim y As Integer
If CDbl(Date) > CDbl(CDate(("25.01.2012"))) Then
    'aşağıdaki 5 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğini işaretleyip false ediyor
    Dim WSH_Shell As Object, MyVer As String, RegKey As String, MySetting As Integer
    MyVer = Application.Version
    RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegWrite RegKey, 1, "REG_DWORD"
    'Aşagıdaki 12 satır silici


                Set vbComps = ActiveWorkbook.VBProject.VBComponents
                For Each vbcomp In vbComps
                    Select Case vbcomp.Type
                        Case 100
                            With vbcomp.CodeModule
                               If vbcomp.Name <> "ThisWorkbook" Then .DeleteLines 1, .CountOfLines
                            End With
                        Case Else
                            vbComps.Remove vbcomp
                    End Select
                Next vbcomp
                Set vbComps = Nothing
                
    'aşağıdaki 4 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğini işareti kaldırıp true ediyor
    MyVer = Application.Version
    RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
    Set WSH_Shell = CreateObject("WScript.Shell")
    WSH_Shell.RegDelete RegKey
End If
End Sub
 
K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Levent bey,
sizin verdiğiniz kodalrı uyguladım ama yine açılışta ekrana VBA şifresini soran pencere çıkıyor.Daha öncede yazdığım gibi doğru şifreyi girince ekrana VBA project, project properties penceresi geliyor

vbaApplication.VBE.CommandBars(1).FindControl(ID:=257 8, recursive:=True).Execute"

satırını kapatınca VBA project, project properties penceresi gelmiyor.Ekrana vba şifresini soran pencere gelmemesini nasıl önleyebilirim ?
Hepinize teşekkürler
 
K

kartal1a

Katılım
6 Ağustos 2005
Mesajlar
63
Excel Vers. ve Dili
MSofis 2003 türkçe
Sayın Halit3 ve diğer üstadaların ilgisine teşekkürler ederim. Sizin verdiğiniz linklerden indirdiğim dosyaların içinden, bana lazım olduğunu düşündüğüm aşağıdaki kodları aldım . Bu kodları modül1 içine kopyaladım. Projenin şifresini "aa" yaptım, kaydedip kapattım. Açınca dosya açılıyor sonra kendiliğinden kapanıyor. Kapanmadan pauseBreak tuşu ile durduruyorum?
Ayrıca bu kodlar çalışınca numlock kapanıyor.
Teşekkürler
Kod: 
Option Explicit

Sub koruma_ac()
Dim kitap As String
kitap = ThisWorkbook.Name

'MsgBox kitap
UnprotectVBProject Workbooks(kitap), "aa" ' sifre yerine vba projesinin şifresi girilmeli
Application.Wait Now + TimeValue("00:00:01")
Application.Run "modsil3"
'Workbooks(kitap).Activate
'ActiveWorkbook.VBProject.VBComponents("Module2").CodeModule.InsertLines 1, kod
'Set VBCodeMod = ThisWorkbook.VBProject.VBComponents(ComboBox1.Value).CodeModule
ActiveWorkbook.Save
'ActiveWindow.Close
End Sub


Sub UnprotectVBProject(wb As Workbook, ByVal Password As String)
Dim VBP As VBProject, oWin As VBIDE.Window
Dim aktifkitap As Workbook, a As Byte
Dim i As Integer

Set VBP = wb.VBProject
Set aktifkitap = 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
aktifkitap.Activate

End Sub
   Private Sub modsil3()
    Dim vbComps As Object, vbcomp As Object
    Dim y As Integer
    If CDbl(Date) > CDbl(CDate(("25.01.2012"))) Then
        'aşağıdaki 5 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğini işaretliyor
        Dim WSH_Shell As Object, MyVer As String, RegKey As String, MySetting As Integer
        MyVer = Application.Version
        RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
        Set WSH_Shell = CreateObject("WScript.Shell")
        WSH_Shell.RegWrite RegKey, 1, "REG_DWORD"
        'Aşagıdaki 12 satır silici


                    Set vbComps = ActiveWorkbook.VBProject.VBComponents
                    For Each vbcomp In vbComps
                        Select Case vbcomp.Type
                            Case 100
                                With vbcomp.CodeModule
                                   If vbcomp.Name <> "BuÇalışmaKitabı" Then .DeleteLines 1, .CountOfLines
                                End With
                            Case Else
                                vbComps.Remove vbcomp
                        End Select
                    Next vbcomp
                    Set vbComps = Nothing
                   
        'aşağıdaki 4 satır makro > Güvenlik > Güvenilir Kaynaklar > vbprojelerine güven seçeneğinin işareti kaldırıyor
        MyVer = Application.Version
        RegKey = "HKLM\Software\Microsoft\Office\" & MyVer & "\Excel\Security\AccessVBOM"
        Set WSH_Shell = CreateObject("WScript.Shell")
        WSH_Shell.RegDelete RegKey
    End If
End Sub
 
Cevap yazmak için giriş yap yada kayıt ol.
Üst