MS Excel 2007 - zpřístupnění listů sešitu různým uživatelům

takze:
jeden list v sesitu musi byt viditelny, zde umisti neco vseobecneho, dalsi listy pak uz lze skryt a otevirat vlozenim hesla.

v editoru VBA vloz do objektu Tento sesit (thisWorkbook) udalostni proceduru (listy pojmenuj dle potreby), u hesel jsou rozlisovana mala a velka pismena:

Option Explicit
Option Compare Binary

Private Sub Workbook_Open()
Dim List As Worksheet, Sesit As Workbook
Dim Heslo As String
Set Sesit = ActiveWorkbook
For Each List In Sesit.Worksheets
If List.Name "List1" Then List.Visible = xlSheetVeryHidden
Next List
Heslo = Application.InputBox("Zadej sve heslo pro pristup.", , , , , , , 2)
Select Case Heslo
Case "heslo1"
Worksheets("list2").Visible = True
Case "heslo2"
Worksheets("list3").Visible = True
'dalsi hesla
Case Else
MsgBox "Chybne heslo, pristup odmitnut"
End Select
End Sub

a v Tools>VBAProjectProperties>Protection vloz heslo - zabezpecis proceduru

a sesitu prirad heslo pro otevreni (zabranis triku otevirani sesitu se stisknutym shiftem):
Ulozit jako>Nastroje>Obecne moznosti>Heslo pro otevreni, staci heslo jeden znak, napr.: "*" (hvezdicka)

Díky, bomba!!!

Jenom bych chtěl poradit, jak přesně "v editoru VBA vloz do objektu Tento sesit (thisWorkbook) udalostni proceduru"? Editor mám spuštěný, ale skutečně nevím, jak a kde vložit do objektu ......

Díky moc

Jsem fakt lama!!! Již jsem to zjistil, ale musím ještě něco nastavit, aby se procedura spouštěla? Udělal jsem vše podle pokynů, ale všechny listy jsou viditelné a ani to po mě nechce zadat heslo pro přístup k jednotlivým sešitům
Děkuji

takze kdyz se ti podarilo udalostni proceduru vlozit do editoru, je nutno sesit ulozit jako "Sesit aplikace Excel s podporou maker", dale je nutno nastavit zabezpeceni maker - Vyvojar>Zabezpeceni maker>Nastaveni maker>Zakaazat vsechna makra s oznamenim.
Po otevreni sesitu je zobrazen pozadavek na povoleni maker.

Jinak prikladam sofistikovanejsi verzi:

vedle uvodniho listu vloz list napr. "Hesla", bude pristupny po zadani generalniho hesla
v A1 je nazev tohoto listu - Hesla,
v B1, C1 a dalsich jsou nazvy listu pro uzivatele;
v A2 je generalni heslo, ktere umozni zviditelnit vsechny listy
v B2,C2 a dalsich jsou hesla pro uzivatele - zviditelneni prislusneho listu
v dalsich radcich pak bude procedura zaznamenavat cas otevreni sesitu dle uzivatelu (hesel)

do objektu This workbook (uvodni list ma jmeno "List1", pri prejmenovani uprav v procedurach!):

Option Explicit
Option Compare Binary

Private Sub Workbook_Open()
' zneviditelneni listu, dotaz na heslo, zviditelneni prislusneho listu
Dim List As Worksheet, Sesit As Workbook
Dim Heslo As String, c As Range, Sloupec As Range
Set Sesit = ActiveWorkbook
For Each List In Sesit.Worksheets
If List.Name "List1" Then List.Visible = xlSheetVeryHidden ' mimo uvodni list - List1
Next List
Heslo = Application.InputBox("Zadej sve heslo pro pristup.", , , , , , , 2)
Set List = ActiveWorkbook.Worksheets("Hesla") ' list s hesly a prislusnymi listy
Set c = List.Range("2:2").Cells(Range("2:2").Columns.Count) ' nalezeni posledni bunky v radku 2 na listu Hesla
If IsEmpty(c) Then Set c = c.End(xlToLeft)
Set c = List.Range("a2").Resize(1, c.Column)
Set c = c.Find(Heslo, LookIn:=xlValues, lookat:=xlWhole) ' nalezeni hesla na radku
If c Is Nothing Then
' heslo nenalezeno
MsgBox "Nekorektni heslo, pristup odmitnut"
Sesit.Save
Sesit.Close
End
Else
' heslo nalezeno
Set Sloupec = List.Range("a:a").Offset(0, c.Column - 1)
If Sloupec.Address(0, 0) = "A:A" Then
' zobrazit vsechny listy… po zadani generalniho hesla (je v 1. sloupci)
For Each List In Sesit.Worksheets
If List.Name "List1" Then List.Visible = True
Next List
Else
' zobrazit a aktivovat list prislusny heslu
Worksheets(c.Offset(-1, 0).Value).Visible = True
Worksheets(c.Offset(-1, 0).Value).Select
End If
Set c = Sloupec.Cells(Sloupec.Rows.Count) ' nalezeni posledni bunky sloupce
If IsEmpty(c) Then Set c = c.End(xlUp)
c.Offset(1, 0).Value = Now ' zapis udalosti do prislusneho sloupce
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'zneviditelneni vsech listu pri uzavreni sesitu
Dim List As Worksheet, Sesit As Workbook
Set Sesit = ActiveWorkbook
For Each List In Sesit.Worksheets
If List.Name "List1" Then List.Visible = xlSheetVeryHidden
Next List
Sesit.Save
End Sub

Heslo pro sesit a procedury zustava jak uvedeno drive Ukázat celý příspěvek

SUPER!!!
Tato 2. verze funguje na 100%. U přechozí šlo procházet všechny listy sešitu, než se povolila makra. Tady ta 2 je verze zcela SUPER a funguje úžasně.
Děkuji MOC!!!!!!!!!!!!!!!!!!

Ještě 1x VELIKÉ díky, vše funguje naprosto skvěle!!
Chtěl bych se zeptat, zda by šlo současně po zadání hesla ještě automaticky určit, zda uživatel bude mít dokument jenom pro čtení (aby nemohl nic měnit) nebo i pro zápis. Byla by to taková třešnička na dortu. Tento parametr by byl uložen vedle úvodního listu v listu "HESLA" v řádku pod hesly.
Děkuji opět moc předem

Na listu Helsa vloz na pozici 3. radku novy radek a pro listy, ktere maji byt jen pro cteni, zadej Protect (v pripade jineho oznaceni nutno zmenit v procedurach!).
Pri pouziti generalniho hesla budou take vsechny listy odemknuty, pri uzavreni souboru pak prislusne listy uzamknuty generalnim heslem.
Zde je upravena procedura - objekt This workbook:

Option Explicit
Option Compare Binary

Private Sub Workbook_Open()
' zneviditelneni vsech listu, dotaz na heslo, zviditelneni prislusneho listu
Dim List As Worksheet, Sesit As Workbook
Dim Heslo As String, c As Range, Sloupec As Range
Set Sesit = ActiveWorkbook
For Each List In Sesit.Worksheets
If List.Name "List1" Then List.Visible = xlSheetVeryHidden ' mimo uvodni list - List1
Next List
Heslo = Application.InputBox("Zadej sve heslo pro pristup.", , , , , , , 2)
Set List = ActiveWorkbook.Worksheets("Hesla") ' list s hesly a prislusnymi listy
Set c = List.Range("2:2").Cells(Range("2:2").Columns.Count) ' nalezeni posledni bunky v radku 2 na listu Hesla
If IsEmpty(c) Then Set c = c.End(xlToLeft)
Set c = List.Range("a2").Resize(1, c.Column)
Set c = c.Find(Heslo, LookIn:=xlValues, SearchOrder:=xlByRows) ' nalezeni hesla na radku
If c Is Nothing Then
' heslo nenalezeno
MsgBox "Nekorektni heslo, pristup odmitnut"
Sesit.Save
Sesit.Close
End
Else
' heslo nalezeno
Set Sloupec = List.Range("a:a").Offset(0, c.Column - 1)
If Sloupec.Address(0, 0) = "A:A" Then
' zobrazit vsechny listy po zadani generalniho hesla (je v 1. sloupci) a odemknout listy
For Each List In Sesit.Worksheets
If List.Name "List1" Then
List.Visible = True
List.Unprotect password:=Heslo
End If
Next List
Else
' zobrazit a aktivovat list prislusny heslu
Worksheets(c.Offset(-1, 0).Value).Visible = True
Worksheets(c.Offset(-1, 0).Value).Select
End If
Set c = Sloupec.Cells(Sloupec.Rows.Count) ' nalezeni posledni bunky sloupce
If IsEmpty(c) Then Set c = c.End(xlUp)
c.Offset(1, 0).Value = Now… ' zapis udalosti do prislusneho sloupce
End If
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)
'zneviditelneni vsech listu pri uzavreni sesitu a uzmknuti listu s Protect
Dim List As Worksheet, Sesit As Workbook, Hesla As Range, c As Range
Set Sesit = ActiveWorkbook
Set List = Sesit.Worksheets("Hesla") ' list s hesly a prislusnymi listy a protect
Set Hesla = List.Range("2:2").Cells(Range("2:2").Columns.Count) ' nalezeni posledni bunky v radku 2 na listu Hesla
If IsEmpty(Hesla) Then Set Hesla = Hesla.End(xlToLeft)
Set Hesla = List.Range("a2").Resize(1, Hesla.Column)
For Each List In Sesit.Worksheets
If List.Name "List1" Then
Set c = Hesla.Offset(-1, 0).Find(List.Name, LookIn:=xlValues, SearchOrder:=xlByRows)
If c.Offset(2, 0).Value = "Protect" Then List.Protect password:=Worksheets("Hesla").Range("a2").Value
List.Visible = xlSheetVeryHidden
End If
Next List
Sesit.Save
End Sub Ukázat celý příspěvek

Doplnuji: pro neuzamknute listy je potreba zadat nap.: Unprotect, bunka by nemela byt prazdna, jinak bude do ni zapsana udalost otevreni.