Makro yardımı

[Mehmet Sait]

Merhaba,

50 sayfalık bir çalışma kitabım mevcut.
Makro ile tüm sayfa hücrelerin klitli ve gizli ve sonrasında sayfayı şifrelemek mümkün mü?

Yardımlarınız için teşekkür ederim.

 

[AdemCan]

Merhaba,
Öncelikle konu başlığınızı forum kuralları gereği, soruyu özetleyecek şekilde güncelleyiniz.

Belirttiğiniz konu için ilgili kodlar.

Sub test()
Application.ScreenUpdating = False
For i = 1 To Sheets.Count
    Sheets(i).Cells.Locked = True
    Sheets(i).Cells.FormulaHidden = True
    Sheets(i).Protect "Şifre"
Next i
Application.ScreenUpdating = True
End Sub

 

[muratboz06]

Deneyiniz.
Şifreyi 123456 yapar, kendinize göre değiştiriniz.

Sub HucreleriVeSayfalariKoru()
    
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Select
        ws.Cells.Select
        Selection.Locked = TRUE
        Selection.FormulaHidden = Ture
        ws.Cells(1, 1).Select
        ws.Protect Password:="123456"
    Next ws
 
    MsgBox "İşlem tamamlandı.", vbOKOnly
    
End Sub

 

[Mehmet Sait]

Aşağıdaki kodu ThisWorkbook kod editorüne yazınız

Option Explicit
Sub KayıtKontrol()
    Dim str As String
    Dim i As Long
    Dim No As Long
    Dim KaydıYapan As String
    Dim Say As Long
    i = 199
    str = String$(200, 0)
    No = GetUserName(str, i)
    If No <> 0 Then KaydıYapan = Left$(str, i) Else KaydıYapan = ""
    Say = WorksheetFunction.CountA(ThisWorkbook.Sheets("Sayfa1").Range("A1:A65500")) + 1
    ThisWorkbook.Sheets("Sayfa1").Range("A" & Say) = KaydıYapan
End Sub
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    KayıtKontrol
End Sub

Aşağıdaki Api yi de yeni bir modül içerisine yazınız

Declare Function GetUserName Lib "advapi32.dll" Alias _
"GetUserNameA" (ByVal lpBuffer As String, nSize As Long) _
As Long

Bu kod Sayfa1 adlı sayfanın A sutünuna bilgisayar oturumunu açan kullanıcının adını yazar. Sayfa1 yerine başka bir sayfaya kaydedilmesini isterseniz Kodlardaki Sayfa1 i kendi sayfa isminizle değiştirin.

Sub test() Application.ScreenUpdating = False For i = 1 To Sheets.Count Sheets(i).Cells.Locked = True Sheets(i).Cells.FormulaHidden = True Sheets(i).Protect "Şifre" Next i Application.ScreenUpdating = True End Sub

Teşekkür ederim

 

[Mehmet Sait]

Deneyiniz.
Şifreyi 123456 yapar, kendinize göre değiştiriniz.

Sub HucreleriVeSayfalariKoru()
   
    Dim ws As Worksheet
    For Each ws In ThisWorkbook.Worksheets
        ws.Select
        ws.Cells.Select
        Selection.Locked = TRUE
        Selection.FormulaHidden = Ture
        ws.Cells(1, 1).Select
        ws.Protect Password:="123456"
    Next ws

    MsgBox "İşlem tamamlandı.", vbOKOnly
   
End Sub

Teşekkür ederim