» Poradna » Programy

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

 |   | 

Zdravím všechny
Mám následující problém: v sešitu pro MS EXCEL 2007 je několik listů. Já bych potřeboval, aby listy byly přístupné v závislosti na zadání hesla. Tzn. že by každý list měl své heslo, po otevření sešitu a vyplnění hesla by byl přístupný, viditelný a čitelný pouze onen list, ale již žádný jiný v onom sešitu. Jde mi o to, aby se lidem přidělila hesla a oni si otevřeli sešit, zadali heslo a viděli pouze svůj list a nic jiného.
Jde toto vůbec nějakým způsobem realizovat?
Děkuji předem za všechny rady

Mohlo by vás také zajímat

Odpovědi na otázku

 |   | 

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)

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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 Ukázat celý příspěvek

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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!!!!!!!!!!!!!!!!!!

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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 Ukázat celý příspěvek

Souhlasím  |  Nesouhlasím  |  Odpovědět
 |   | 

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

Souhlasím  |  Nesouhlasím  |  Odpovědět

Související témata: MS Excel


Určitě si přečtěte

Můžete mít dvakrát rychlejší VDSL? Mapa Cetinu ukazuje, kde je dostupný bonding
Lukáš Václavík
CETINPřipojení k internetu
Čekali jsme skoro šest let. Android Auto jede do Česka i na Slovensko
Lukáš Václavík
Android AutoNavigaceGoogle
Technici nestíhají. Cetin dočasně přerušil zavádění VDSL bondingu
Lukáš Václavík
CETINPřipojení k internetu
Japonská MANA může být 80× výkonnější než sebelepší tranzistorový procesor

Japonská MANA může být 80× výkonnější než sebelepší tranzistorový procesor

** Tranzistory současných počítačů vyzařují při přepínání teplo ** Na Tokijské univerzitě proto vyvíjejí adiabatické procesory ** Využívají supravodivost a jsou 80× úspornější

Jakub Čížek | 48

Jakub Čížek
TranzistoryProcesoryTechnologie
Platby kartou se můžou rozšířit úplně všude. Jako terminál poslouží mobil
Lukáš Václavík
BankaPlacení mobilemNFC
Nejlepší notebooky do 10 000 korun: Co má ještě smysl kupovat. A co ne?

Nejlepší notebooky do 10 000 korun: Co má ještě smysl kupovat. A co ne?

** Notebooky s cenou do deseti tisíc korun jsou plné kompromisů ** Existuje několik modelů dobře použitelných pro nenáročné použití ** Vhodnou alternativou jsou tablety nebo repasované počítače

David Polesný | 94

David Polesný
Jak vybrat notebookNotebooky
Nešťastný vývojář ukazuje, proč není dobré být závislý na Googlu
Lukáš Václavík
InternetGoogle