toegang tot inzien map in Excel na invoeren wachtwoord

[rvdw1968]

Hallo,

Ik heb een excel-document dat voor iedereen toegankelijk is. Er is echter één map in dit document waarbij ik wil dat men deze pas kan inzien nadat er een wachtwoord is ingevoerd. Is dit mogelijk in excel?

Voor de goede orde, ik weet dat je een map kunt beveiligen tegen het uitvoeren van bewerkingen dmv "Blad beveiligen" en "Werkmap beveiligen", het is echter de bedoeling dat men pas kennis kan nemen van de inhoud van de map, nadat er een wachtwoord wordt ingevoerd.

Alvast dank voor jullie antwoord.

 

[edmoor]

Dat kan met een stukje VBA als je dat wil.

 

[rvdw1968]

Dat kan met een stukje VBA als je dat wil.

Ik ben niet zo thuis in VBA, ik weet wel hoe ik het in een document kan verwerken.

Zou u mij kunnen helpen met de VBA? De naam van de map die het betreft is "OZ team 3"

Alvast dank voor uw hulp

 

[edmoor]

Simpel voorbeeld. Het wachtwoord is 1234
Dat kan uiteraard nog veel mooier en geavanceerder.

 

[rvdw1968]

Simpel voorbeeld. Het wachtwoord is 1234
Dat kan uiteraard nog veel mooier en geavanceerder.

Hallo Edmoor,

Dank voor de hulp, hij werkt echter niet helemaal goed, ik heb de tekst in ThisWorkbook geplaatst en de code ziet er nu als volgt uit:

Private Sub Workbook_SheetActivate(ByVal Sh As Object)
    If Sh.Name = "OZ Team 3" Then
        pwd = InputBox("Wachtwoord", "OZ Team 3")
        If pwd = "1234" Then
            Sh.Cells.EntireRow.Hidden = False
        End If
    End If
End Sub

Private Sub Workbook_SheetDeactivate(ByVal Sh As Object)
    If Sh.Name = "OZ Team 3" Then Sh.Cells.EntireRow.Hidden = True
End Sub


Private Sub Workbook_Open()

Recalc
SchedRecalc = Now + TimeValue("00:00:01")
Application.OnTime SchedRecalc, "Recalc"

hoofdletters
SchedRecalc = Now + TimeValue("00:01:43")
Application.OnTime SchedRecalc, "hoofdletters"

SaveMe
SchedRecalc = Now + TimeValue("00:01:30")
Application.OnTime SchedRecalc, "saveme"

OLZnaarDoorloop
SchedRecalc = Now + TimeValue("00:05:04")
Application.OnTime SchedRecalc, "OLZnaarDoorloop"

End Sub

Zoals je ziet, er staat nog andere tekst bij die ook noodzakelijk is voor het document.

Indien ik naar de map OZ Team 3 ga, wordt de inhoud van de map al zichtbaar bij het invoeren van het wachtwoord, dat is dat is niet de bedoeling, alleen mensen die het wachtwoord weten mogen hier inzage in krijgen.

Als ik het ww heb ingevoerd en ik ga vervolgens weer naar een andere map dan krijg ik foutcode 1004 (Eigenschap Hidden van klasse Range kan niet worden ingesteld)

Is is op een eenvoudige wijze op te lossen?

Bij voorbaat heel veel dank

 

[edmoor]

In mijn voorbeeld document werkt het zoals je vroeg.
Tevens heb je niet alles overgenomen.
En uiteraard moet je het wachtwoord weten om de inhoud zichtbaar te krijgen.
Plaats anders je eigen document hier.

 

[edmoor]

En dan nog een keer maar zonder wachtwoord op het VBA project.

 

[edmoor]

En de blad beveiliging van OZ Team 3 uiteraard ook.

 

[edmoor]

Als je het werkblad OZ Teams 3 een andere naam geeft en een nieuwe met die naam maakt werkt het prima.
Ik heb zo geen idee waarom dat op het originele blad niet werkt en nu helaas geen tijd om dat uit te zoeken.

 

[rvdw1968]

schrijfrechten in map na wachtwoord

Hallo Edmoor,

Ik heb vanalles geprobeerd maar het is mij niet gelukt om het goed lopend te krijgen.

Ik zou graag voor elkaar krijgen dat enkel mensen die een wachtwoord invoeren, in de map kunnen schrijven. De map hoeft niet meer verborgen te zijn, enkel schrijfrechten moeten toegekend worden aan degene die het juiste wachtwoord invoert.

Ik heb onderstaande code in het document staan:

Sub ontveilig_OZ()

Set OZ = Sheets("OZ Team 3")
With OZ
pwd = InputBox("Wachtwoord", "OZ Team 3")
If pwd = "t3r" Then .Unprotect
End With

End Sub

Op een of andere manier moet ik nu twee keer het wachtwoord invoeren, de eerste keer is zichtbaar wat ik typ, de tweede keer komen er (de gewenste) bolletjes,
Fijn zou zijn als ik maar één keer het wachtwoord hoef te typen waarbij ik bolletjes zie in plaats van de letters die ik typ. Helemaal ideaal zou het zijn als kolom K en kolom H beveiligd zouden blijven, ook na ontgrendeling van het document.

(indien er om een ww wordt gevraagd, dan is dat "t3r" maar dat had je vast al in de code gezien )

Alvast dank voor de hulp

Ruud

 

[edmoor]

Je vergeet bij het ontveiligen het wachtwoord mee te geven, dan vraagt Excel er zelf om.
Het gebruik van die bolletjes kan niet met een Inputbox, dan moet je het aan Excel zelf overlaten.
Plus nog wat extra's met je knoppen gedaan.
Zie je document:

 

[rvdw1968]

Beste Edmoor,

dit is fantastisch, dank je wel!

Is het ook nog te realiseren dat de kolommen H en K wél beveiligd blijven ondanks dat de rest van de map ontgrendeld is? (dit ter voorkoming dat bepaalde formules per abuis verwijderd worden)

Verder is het zo dat nu alle wisknoppen gewoon functioneren terwijl de map vergrendeld is. Indien de map vergrendeld is, zou de functionaliteit van de wisknoppen ook geblokkeerd moeten zijn. Is dat te realiseren?

vriendelijke groeten,
Ruud

 

[edmoor]

Dat laatste kan zo.
Haal al die code weg en hang deze macro aan die knoppen:

Sub WissenOZ3regel()
    If ActiveSheet.ProtectContents Then Exit Sub
    r = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    Range("A" & r & ",B" & r & ",C" & r & ",D" & r & ",E" & r & ",F" & r & ",I" & r).ClearContents
End Sub

Dat eerste kan met dit achter dat werkblad. Dat kan je even uitschakelen als je wel iets in die kolommen wilt doen.

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Column = 8 Or Target.Column = 11 Then Target.Offset(, 1).Activate
End Sub

 

[HSV]

De offset(,1) kan direct vanaf target Ed.

 

[edmoor]

Kan ook inderdaad en is beter
Aangepast.

 

[rvdw1968]

Heel hartelijk dank Edmoor, ik ga ermee aan de slag

 

[edmoor]

Toch nog een wijziging in macro voor de Wis knoppen (korter):

Sub WissenOZ3regel()
    If ActiveSheet.ProtectContents Then Exit Sub
    r = ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row
    Range("A" & r & ":F" & r & ",I" & r).ClearContents
End Sub

 

[rvdw1968]

Beste Edmoor,

Dank voor al je hulp, het werkt nu precies zoals ik het voor ogen had!

 

[snb]

Sub M_snb()
  If ActiveSheet.ProtectContents Then Exit Sub
  Intersect(range("A:F,I:I"),ActiveSheet.Shapes(Application.Caller).TopLeftCell.Row).clearcontents
End Sub