VBA om beveiliging op te heffen gebaseerd op bestandslocatie

Status
Niet open voor verdere reacties.

Patrick6411

Gebruiker
Lid geworden
15 dec 2012
Berichten
13
Binnen onze organisatie gebruiken we complexe Excel-sheets die aan diverse personen wordt gemaild met het verzoek die in te vullen en te retourneren. Het is van levensbelang dat deze personen - soms behept met mindere Excel-kennis - de formules en structuur van het document niet wijzigen. Dit terwijl onze afdeling zelf wel allerhande wijzigingen moet kunnen aanbrengen. Daarom had ik het volgende bedacht: Een macro die
1) bij het openen van het bestand checkt waar het is opgeslagen.
Is dat in de directory van onze afdeling, dan wordt de beveiliging van alle bladen en de worksheet in totaal opgeheven. Is dat anders, blijft de beveiliging er op zitten.
2) bij het afsluiten de beveiliging er vanzelf weer op zet.

Is dat mogelijk en hoe zou dat moeten? Your help is greatly appreciated!
 
Zoiets in de ThisWorkbook sectie:
Code:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
    Call ProtectSheets
End Sub

Private Sub Workbook_Open()
    If ThisWorkbook.Path = "C:\EigenMap" Then
        Call UnProtectSheets
    End If
End Sub

Private Sub ProtectSheets()
    For Each sht In ThisWorkbook.Sheets
        sht.Protect "Wachtwoord"
    Next sht
End Sub

Private Sub UnProtectSheets()
    For Each sht In ThisWorkbook.Sheets
        sht.Unprotect "Wachtwoord"
    Next sht
End Sub
 
Het werkt, bijna!

Thanx edmoor, Dit werkt.
Nu heb ik het probleem dat de exacte bestandslocatie waar de beveiliging er af moet niet altijd dezelfde is, maar wel altijd een subdirectory is van één map (dus wel altijd ergens in C:\Eigenmap maar soms is het C:\Eigenmap\map1 en soms C:\Eigenmap\map2 enz). Dus hij moet alleen naar het begin van het path kijken. Is dat ook nog op te lossen?
 
Tuurlijk:
Code:
Private Sub Workbook_Open()
    If Left(ThisWorkbook.Path, 11) = "C:\EigenMap" Then
        Call UnProtectSheets
    End If
End Sub
 
Status
Niet open voor verdere reacties.
Terug
Bovenaan Onderaan