Hej Johan,

Jag skrev ett liknande macro för ett par år sedan. Två skillnader från din förfrågan:

1. Access ges till specifika celler i aktuellt sheet. (Borde dock gå att ändra till olika sheets istället)
2. Access ges baserat på användarens username, alltså behövs inte lösenord om användaren loggar in från "sin" dator, och du vet vilka användarnamn som skall få vilken access.

Testa genom att skriva ditt eget användarnamn i en cell, kopiera in macrona, spara och stäng filen. Öppna den igen, nu bör du bara kunna redigera 4x2 celler under cellen du skrev ditt användarnnamn i.

Du får alltså ha någon form av master-data där du skriver vilka användare som skall ha tillgång till vilka sheet. (istället för 4x2 celler som i mitt fall)

//Erik

Sub Workbook_Open()
Application.ScreenUpdating = False

' Unlock the active sheet
ActiveSheet.Unprotect Password:="Zlatan81"

' Finds the username and selects the 4x2 cells below the username
Cells.Find(What:=(Environ$("Username")), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Offset(1, 0).Resize(Selection.Rows.Count + 3, Selection.Columns.Count + 1).Select

' Makes the above selected cells unlocked
Selection.Locked = False
Selection.FormulaHidden = False

' Selects the cell 2 cell above the username (In this case that cell is the real name of the user)
Cells.Find(What:=(Environ$("Username")), After:=ActiveCell, LookIn:=xlFormulas, LookAt:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False, SearchFormat:=False).Activate
Selection.Offset(-2, 0).Select

'Lock the active sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="Zlatan81"
Application.ScreenUpdating = True

End Sub

Sub Workbook_beforeclose(Cancel As Boolean)
Application.ScreenUpdating = False

' Unlock the active sheet
ActiveSheet.Unprotect Password:="Zlatan81"

'Protects all cells
Cells.Select
Selection.Locked = True
Selection.FormulaHidden = False
Cells(1, 1).Select

'Lock the active sheet
ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True, AllowFiltering:=True, Password:="Zlatan81"
Application.ScreenUpdating = True

'Saves the workbook
ThisWorkbook.Close SaveChanges:=True

End Sub

 Hej,

Ska filen användas i ett nätverk eller ska den skickas runt via mail utanför nätverket?

Jag skulle nog låta alla användare som startar filen behöva skriva in ett lösenord. Om lösenordet är fel stängs arbetsboken  (t.ex. genom if lösen=fel eller att inloggningen avbryts then Activeworkbook.close) annars visas de flikar som lösenordet ger behörighet till. 

D.v.s om man skriver in

"lösen1" visas bara blad1

"lösen2" visas blad1 och blad2

"lösen3" visas blad1, blad2 och blad3

O.s.v

 

Om filen ska användas i ett nätverk är det nog lättast med någon styrning via det nätverksnamn användaren har i nätverket för att sedan styra behörigheten till bladen och skippa lösenord. Enklast kanske vore att använda någon typ av befintlig behörighetsstyrning t.ex om användare kommer åt denna mapp i nätverket så visa blad1 om användaren har tillgång till x-mappen visa då blad1 och blad2, om användaren har tillgång till y-mappen visa då blad1, blad2 och blad3 o.s.v 

Förslag två är någon typ av SQL-fråga till en excel-fil där du själv ställer behörighetsnivå beroende nätverksanvändarnannet.