Zorunlu Macro Etkinleştirme

[sedsa]

Merhaba,
Çalışma sayfasının açılışında macro etkinleştirmeyi zorunlu kılmak için nasıl bir kod gereklidir.Macrolar etkinleştikten sonra ancak çalışma sayfasının içeriğine erişilebilsin.

 

[Mahir64]

Merhaba,
Çalışma sayfasının açılışında macro etkinleştirmeyi zorunlu kılmak için nasıl bir kod gereklidir.Macrolar etkinleştikten sonra ancak çalışma sayfasının içeriğine erişilebilsin.

Merhaba
Çalışma Kitabına şifre verin bence.

 

[sedsa]

Merhaba
Çalışma Kitabına şifre verin bence.

evet ama 20 adet çalışma kitabı var ve birbirlerinden veri çekiyorlar.bu dosyalar ağ paylaşımda buluyor ve patronlar buradan girip verileri görmeleri gerek.diğer yetkisiz kişilerin dosyalara girmelerini ve kopyalamalarını engellemem gerek.evet biliyorum vba şifre kırılabiliyor ama burada ileri excel bilgisi olan yok.Birbirlerinden veri çektikleri için bir çalışma sayfası açtığımda bisürü şifre girmem gerekiyor her seferinde.

 

[uzmanamele]

merhaba

ek dosya işinizi görür mü?

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
    On Error Resume Next
Application.ScreenUpdating = False
    Call SayfalariGizle
Application.ScreenUpdating = True
End Sub

Sub SayfalariGizle()
On Error Resume Next
Application.ScreenUpdating = False
Sheets("ANA_SAYFA").Move Before:=Sheets(1)
For i = 2 To Worksheets.Count
ThisWorkbook.Sheets(i).Visible = xlSheetVeryHidden
Next i
Application.ScreenUpdating = True
End Sub

Sub SayfalariGoster()
Application.ScreenUpdating = False
For i = 2 To Worksheets.Count
ThisWorkbook.Sheets(i).Visible = xlSheetVisible
Next i
Application.ScreenUpdating = True
End Sub

Private Sub Worksheet_Activate()
ActiveSheet.Name = "ANA_SAYFA"
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Call SayfalariGoster
End Sub

Private Sub Worksheet_Deactivate()
If Me.Name <> ANA_SAYFA Then
Me.Name = "ANA_SAYFA"
End If
End Sub

 

[sedsa]

Option Explicit

Const WelcomePage = "SEDAT"

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Evaluate if workbook is saved and emulate default propmts
With ThisWorkbook
If Not .Saved Then
Select Case MsgBox("Yaptığınız Değişiklikleri Kaydetmek İstiyor musunuz. " & .Name & " ?", _
vbYesNoCancel + vbExclamation)
Case Is = vbYes
'Call customized save routine
Call CustomSave
Case Is = vbNo
'Do not save
Case Is = vbCancel
'Set up procedure to cancel close
Cancel = True
End Select
End If

'If Cancel was clicked, turn events back on and cancel close,
'otherwise close the workbook without saving further changes
If Not Cancel = True Then
.Saved = True
Application.EnableEvents = True
.Close savechanges:=False
Else
Application.EnableEvents = True
End If
End With
End Sub

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
'Turn off events to prevent unwanted loops
Application.EnableEvents = False

'Call customized save routine and set workbook's saved property to true
'(To cancel regular saving)
Call CustomSave(SaveAsUI)
Cancel = True

'Turn events back on an set saved property to true
Application.EnableEvents = True
ThisWorkbook.Saved = True
End Sub

Private Sub Workbook_Open()
'Unhide all worksheets
Application.ScreenUpdating = False
Call ShowAllSheets
Application.ScreenUpdating = True
End Sub

Private Sub CustomSave(Optional SaveAs As Boolean)
Dim ws As Worksheet, aWs As Worksheet, newFname As String
'Turn off screen flashing
Application.ScreenUpdating = False

'Record active worksheet
Set aWs = ActiveSheet

'Hide all sheets
Call HideAllSheets

'Save workbook directly or prompt for saveas filename
If SaveAs = True Then
newFname = Application.GetSaveAsFilename( _
fileFilter:="Excel Files (*.xls), *.xls")
If Not newFname = "False" Then ThisWorkbook.SaveAs newFname
Else
ThisWorkbook.Save
End If

'Restore file to where user was
Call ShowAllSheets
aWs.Activate

'Restore screen updates
Application.ScreenUpdating = True
End Sub

Private Sub HideAllSheets()
'Hide all worksheets except the macro welcome page
Dim ws As Worksheet

Worksheets(WelcomePage).Visible = xlSheetVisible

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVeryHidden
Next ws

Worksheets(WelcomePage).Activate
End Sub

Private Sub ShowAllSheets()
'Show all worksheets except the macro welcome page

Dim ws As Worksheet

For Each ws In ThisWorkbook.Worksheets
If Not ws.Name = WelcomePage Then ws.Visible = xlSheetVisible
Next ws

Worksheets(WelcomePage).Visible = xlSheetVeryHidden
End Sub

 

[sedsa]

Aslında yukarıdaki gibi bir kodu sitemiz sayesinde buldum. ama ingilizce sayfaya kaydetmeyi sorduktan sonra çalışma sayfasını kapatıyor ama çalışma kitabını kapatmıyor ve kendi dosyama uyarladığımda gizlemiş olduğum çalışma sayfalarını da her seferinde gösteriyor bunları kodlardan düzenlemek mümkünmü acaba.?İlginiz için teşekkür ederim.