Hi all

I am trying to produce a shared workbook for the weekly payroll, which needs to be accessed by various units, but for them to only have access to the tabs which relate to their units. Due to tight deadlines, they are all likely to be working on the file at the same time - hence the need for a shared workbook.

I have produced a file which contains a macro to restrict the view of the file by user using very hidden worksheets (see macro 1 below) and various other macros to protect/ unprotect sheets and the workbook, restrict selection or allow selection on worksheets, etc.


Macro 1:

Private Declare Function apiGetUserName Lib "advapi32.dll" Alias "GetUserNameA" (ByVal IpBuffer As String, nSize As Long) As Long
Public UserName As String
Private Sub Workbook_BeforeClose(Cancel As Boolean)

Call Unprotect_Workbook_and_Sheets
Call Hide_Sheet(UserName)

End Sub

Private Sub Workbook_Open()
UserName = fNTUserName

Call UnHide_Sheet(fNTUserName)
Call Protect_Workbook_and_Sheets

End Sub

Sub UnHide_Sheet(UserName As String)

Select Case UserName

Case "xxx", "xxx", "xxx" ' Admin View
Worksheets("MAN_DR_Timesheet").Visible = True
Worksheets("MAN_DR_Submission").Visible = True
Worksheets("MAN_WK_Timesheet").Visible = True
Worksheets("MAN_WK_Submission").Visible = True
Worksheets("MID_DR_Timesheet").Visible = True
Worksheets("MID_DR_Submission").Visible = True
Worksheets("LEE_Timesheet").Visible = True
Worksheets("LEE_Submission").Visible = True
Worksheets("PUR_Timesheet").Visible = True
Worksheets("PUR_Submission").Visible = True
Worksheets("Weekly Input").Visible = True
Worksheets("Weekly Rates").Visible = True
Worksheets("Control").Visible = True
Worksheets("Lookup").Visible = True
Worksheets("Notice").Visible = False


Case "xxx", "xxx" ' MAN DR View
Worksheets("MAN_DR_Timesheet").Visible = True
Worksheets("MAN_DR_Submission").Visible = True
Worksheets("Notice").Visible = False


Case "xxx", "xxx" ' MAN WK View"
Worksheets("MAN_WK_Timesheet").Visible = True
Worksheets("MAN_WK_Submission").Visible = True
Worksheets("Notice").Visible = False


Case "xxx", "xxx", "xxx" ' MID DR View
Worksheets("MID_DR_Timesheet").Visible = True
Worksheets("MID_DR_Submission").Visible = True
Worksheets("Notice").Visible = False


Case "xxx", "xxx" ' LEE View
Worksheets("LEE_Timesheet").Visible = True
Worksheets("LEE_Submission").Visible = True
Worksheets("Notice").Visible = False


Case "xxx", "xxx" ' PUR View
Worksheets("PUR_Timesheet").Visible = True
Worksheets("PUR_Submission").Visible = True
Worksheets("Notice").Visible = False


End Select

End Sub

Sub Hide_Sheet(UserName As String)

Worksheets("Notice").Visible = True
Worksheets("MAN_DR_Timesheet").Visible = xlVeryHidden
Worksheets("MAN_DR_Submission").Visible = xlVeryHidden
Worksheets("MAN_WK_Timesheet").Visible = xlVeryHidden
Worksheets("MAN_WK_Submission").Visible = xlVeryHidden
Worksheets("MID_DR_Timesheet").Visible = xlVeryHidden
Worksheets("MID_DR_Submission").Visible = xlVeryHidden
Worksheets("LEE_Timesheet").Visible = xlVeryHidden
Worksheets("LEE_Submission").Visible = xlVeryHidden
Worksheets("PUR_Timesheet").Visible = xlVeryHidden
Worksheets("PUR_Submission").Visible = xlVeryHidden
Worksheets("Weekly Input").Visible = xlVeryHidden
Worksheets("Weekly Rates").Visible = xlVeryHidden
Worksheets("Control").Visible = xlVeryHidden
Worksheets("Lookup").Visible = xlVeryHidden

End Sub
Function fNTUserName() As String

Dim lngLen As Long, lngX As Long

Dim strUserName As String

strUserName = String$(254, 0)
lngLen = 255
lngX = apiGetUserName(strUserName, lngLen)
If lngX < 0 Then
fNTUserName = Left$(strUserName, lngLen - 1)
Else
fNTUserName = ""
End If

End Function



Everything is working fine until I save the file as a shared workbook.

Has anyone got any ideas on this can be done?

Many thanks

Rick

You might want to consider a different approach where the code source
is an xla that uses a data.xls that users inut to. As an example...

My TimesheetManager.xla uses a login dialog over a background sheet in
the pay period file to display a user's sheet when opened. The save
process hides the current user sheet and redisplays the login dialog.
This simplifies managing user access to other sheets in the workbook
because by default all sheets but "Login" are hidden and protected, and
only their sheet gets displayed on successful login (username/password
match stored info).

Login info is stored on "UsrDat" in the xla. Each new timesheet gets
automatically populated with user info. New users are added via pg2 of
the login dialog if their name/info isn't in the UsrDat list.

Admin access to addin features also requires a separate login. This is
how user info is managed, and gives admin the option to set passwords,
add/remove users, and perform various timesheet processing tasks.
Successful login enables the 'Admin' menus for these features. When
admins logout, the default startup UI displays.

The addin is licensed (locked) to the login PC and the Payroll PC
machines. (My licensing methodology allows 2 seats per subscription,
but additional seats can be attached to a subscription as needed for
marginal cost)

Probably too much info but...

<FWIW
The addin supports both Weekly and BiWeekly pay periods. It uses an xlt
that changes every pay period (weekly), and which contain no code.
Timesheets are created from the master sheet in the xlt. This
facilitates revisons without having to tamper with the xla.

Weekly workbooks are sent to payroll. The pay period is tagged as
follows:

Today (Sep2) falls in pay period 37, which gets paid on Fri Sep9;
The workdays for this pay period are Sun Aug28 to Sat Sep03

The timesheet 'Week' field is: Aug28-Sep03 (pp37)


BiWeekly pay periods ID which week the timesheet applies to (A or B).
The timesheet 'Week' field gets populated as follows:

Today (Sep2) falls in week 'B' of pay period 19, which gets paid
on Fri Sep16;

The timesheet 'Week' field is: Aug28-Sep03 (pp19B)

All this is obtained from pay period tables within the addin. These
tables utomatically update each calendar year to match their respective
pay dates.

--
Garry

Free usenet access at http://www.eternal-september.org
Classic VB Users Regroup!
comp.lang.basic.visual.misc
microsoft.public.vb.general.discussion

---
This email has been checked for viruses by Avast antivirus software.
https://www.avast.com/antivirus