Makro İle VBA Parolası Koymak

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Merhaba arkadaşlar. VBA şifresini makro ile koymak mümkün mü ? Nasıl bir kod ile yapılabilir ?
 

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Merhaba arkadaşlar. VBA şifresini makro ile koymak mümkün mü ? Nasıl bir kod ile yapılabilir ?
 

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Merhaba arkadaşlar. VBA şifresini makro ile koymak mümkün mü ? Nasıl bir kod ile yapılabilir ?
 

uzmanamele

Uzman
Uzman
Katılım
26 Eylül 2007
Mesajlar
9,421
Excel Vers. ve Dili
excel 2010
merhaba

konu ile ilgili Levent beyin örnek çalışması olacak, sitede araştırınız.
 

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Sayın uzmanamele ilginize çok teşekkür ederim. Sayın leventm'in konu ile ilgili olabilecek tüm mesajlarına/konulara baktım ancak bir sonuç çıkaramadım.
 
Katılım
31 Ocak 2010
Mesajlar
547
Excel Vers. ve Dili
Excel 2003
Aşağıdaki kodu deneyin.
(Güvenlik/VBA project erişimine güven işaretli olmalı.)

Kod:
Option Explicit
Const BreakIt As String = "%{F11}%TE+{TAB}{RIGHT}%V{+}{TAB}"

Private Sub CommandButton1_Click()
Dim WB As Workbook
Dim Password As String
Set WB = ActiveWorkbook
Password = "123"
Call SetVBProjectPassword(WB, Password)
End Sub

Sub SetVBProjectPassword(WB As Workbook, ByVal Password As String)
Dim VBP
Dim OpenWin
Dim i As Integer
Set VBP = WB.VBProject
Application.ScreenUpdating = False
For Each OpenWin In VBP.VBE.Windows
If InStr(OpenWin.Caption, "(") > 0 Then OpenWin.Close
Next OpenWin
WB.Activate
SendKeys BreakIt & Password & "{tab}" & Password & "~" & "%{F11}~", True
WB.Activate
SendKeys "%{F11}", True
Application.ScreenUpdating = True
'----------------
Call srs
'-------------------
End Sub
Sub srs()
ActiveWorkbook.Save
Application.Quit
End Sub
 
Son düzenleme:

baydeniro

Altın Üye
Katılım
26 Ocak 2007
Mesajlar
4,625
Excel Vers. ve Dili
Ofis 2016
Altın Üyelik Bitiş Tarihi
20-02-2025
Sayın Husgvarna çok çok teşekkür edrim. Seyenizde Excelde bir adım daha ilerledim. Elleriniz dert görmesin.
 
Üst