Sub SetAsReadOnly()
****'** Test for PC User Name
****Dim strUser As String
********strUser = Environ("USERNAME")
********
******** '**Set Read only File Access for each Office's specific version
********Select Case strUser
************'** Full Workbook Access
************Case Is = "YourUserName", "AnotherUser"
****************If ActiveWorkbook.ReadOnly Then _
********************ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="admin"
************'** Limit Access
************Case Is <> "YourUserName"
****************If Not ActiveWorkbook.ReadOnly Then _
********************ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
********End Select

End Sub