Ještě menší úprava, protože takto by se stále ukládala každá kopie ostatním uživatelům pouze pro čtení, takže mě napadlo:
rozhodnutí kdy/komu se soubor otevře pro čtení a kdy/komu pro zápis vytvořit v Modulu1:
Sub Auto_Open()
Dim strUser As String
strUser = Environ("USERNAME")
Select Case strUser
'Full Access
Case Is = "jméno uživatele"
If ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="admin"
'Limit Access
Case Is <> "jméno uživatele"
If Not ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
End Select
End Sub
a k tomu vytvořit Modul2, který v případě otevřeného souboru "pouze pro čtení" nabídne "uložit jako" a zároveň v této uložené kopii zruší omezení z Modulu1 (a zamete po sobě)
Sub Auto_Close()
If ActiveWorkbook.ReadOnly = True Then
Dim vbCom As Object
Set vbCom = Application.VBE.ActiveVBProject.VBComponents
vbCom.Remove VBComponent:=vbCom.Item("Module1")
vbCom.Remove VBComponent:=vbCom.Item("Module2")
Else
If ActiveWorkbook.ReadOnly = True Then
ThisWorkbook.SaveAs Filename:="Sammel" & ".xls", FileFormat:=56
End If
End If
End Sub
Samozřejmě část prvotního požadavku"Uložit jako" s přednastavenou cestou a názvem souboru pak už lze nadefinovat jednoduše. Nejsem profík, možná to jde i líp. Tak to berte s rezervou
citovat
rozhodnutí kdy/komu se soubor otevře pro čtení a kdy/komu pro zápis vytvořit v Modulu1:
Sub Auto_Open()
Dim strUser As String
strUser = Environ("USERNAME")
Select Case strUser
'Full Access
Case Is = "jméno uživatele"
If ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadWrite, WritePassword:="admin"
'Limit Access
Case Is <> "jméno uživatele"
If Not ActiveWorkbook.ReadOnly Then _
ActiveWorkbook.ChangeFileAccess Mode:=xlReadOnly, WritePassword:="admin"
End Select
End Sub
a k tomu vytvořit Modul2, který v případě otevřeného souboru "pouze pro čtení" nabídne "uložit jako" a zároveň v této uložené kopii zruší omezení z Modulu1 (a zamete po sobě)
Sub Auto_Close()
If ActiveWorkbook.ReadOnly = True Then
Dim vbCom As Object
Set vbCom = Application.VBE.ActiveVBProject.VBComponents
vbCom.Remove VBComponent:=vbCom.Item("Module1")
vbCom.Remove VBComponent:=vbCom.Item("Module2")
Else
If ActiveWorkbook.ReadOnly = True Then
ThisWorkbook.SaveAs Filename:="Sammel" & ".xls", FileFormat:=56
End If
End If
End Sub
Samozřejmě část prvotního požadavku"Uložit jako" s přednastavenou cestou a názvem souboru pak už lze nadefinovat jednoduše. Nejsem profík, možná to jde i líp. Tak to berte s rezervou
citovat
RSS nejnovější články