ich habe zwei Tabellenblätter und möchte gerne per Makro sagen können, welche Person welches Tabellenblatt sehen darf.
Vielleicht gibt es da ein Makro, wäre toll.
Vielen lieben Dank!
Heidi
WinUser = Environ("USERNAME")
MSOUser = Application.UserName
eine entsprechende If-Then-Abfrage im AutoOpen sollte das erledigen:if msouser = "bearbeiter1" then sh1.hidden=xlveryhidden
Gruß
Option Explicit
'muss in DieseArbeitsmappe
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Fehler
Dim Sh As Worksheet
Worksheets("Warnung").Visible = True
For Each Sh In Worksheets
If Sh.Name "Warnung" Then
Sh.Visible = xlVeryHidden
End If
Next
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_Open()
Stop 'diese Zeile nach dem Testen wegnehmen
On Error GoTo Fehler
Select Case Environ("Username")
Case "Mueller"
Worksheets("Warnung").Visible = xlVeryHidden
Sheets(1).Visible = True
Case "Meier"
Worksheets("Warnung").Visible = xlVeryHidden
Sheets(2).Visible = True
Case Else
MsgBox "Sie sind kein berechtigter User"
End Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Gruß UweD
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Fehler
Dim Sh As Worksheet
Worksheets("Action").Visible = True
For Each Sh In Worksheets
If Sh.Name "Action" Then
Sh.Visible = xlVeryHidden
End If
Next
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_Open()
On Error GoTo Fehler
Select Case Environ("Username")
Case "Heidi"
Worksheets("Action2").Visible = xlVeryHidden
Sheets(1).Visible = True
Case "e0109732"
Worksheets("Action").Visible = xlVeryHidden
Sheets(2).Visible = True
Case Else
MsgBox "Sie sind kein berechtigter User"
End Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Was mache ich falsch?
Sub testUser()
MsgBox "Benutzer laut Netzwerk: " & Environ("username") & vbLf & vbLf & _
"Rechner laut Netzwerk: " & Environ("computername") & vbLf & vbLf & _
"Benutzer laut Excel: " & Application.UserName
End Sub
Private Sub Workbook_Open()
On Error GoTo Fehler
Select Case Environ("Username")
Case "Heidi","Müller"
Worksheets("Action2").Visible = xlVeryHidden
Sheets("Action").Visible = True
Case "Heidi","e0109732"
Worksheets("Action").Visible = xlVeryHidden
Sheets("Action2").Visible = True
Case Else
MsgBox "Sie sind kein berechtigter User"
End Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_BeforeClose(Cancel As Boolean)
On Error GoTo Fehler
Worksheets("Warnung").Visible = True
Worksheets("Action").Visible = xlVeryHidden
Worksheets("Action2").Visible = xlVeryHidden
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Gruß UweD
Die Datei https://www.herber.de/bbs/user/91620.xlsm wurde aus Datenschutzgründen gelöscht
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wb
Stop
Set Wb = ThisWorkbook
'On Error GoTo Fehler
Wb.Worksheets("Warnung").Visible = True
Wb.Worksheets("Action").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = xlVeryHidden
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_Open()
Dim Wb
Stop
Set Wb = ThisWorkbook
'On Error GoTo Fehler
Select Case Environ("Username")
Case "e0109732", "Mueller", "Schmidt"
Wb.Worksheets("Warnung").Visible = xlVeryHidden
Wb.Worksheets("Action").Visible = True
Case "e0109732", "Meier"
Wb.Worksheets("Warnung").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = True
Case Else
MsgBox "Sie sind kein berechtigter User"
End Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Hast du mehrere Dateien offen?
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wb
Set Wb = ThisWorkbook
Wb.Worksheets("Warnung").Visible = True
Wb.Worksheets("Action").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = xlVeryHidden
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_Open()
Dim Wb
Set Wb = ThisWorkbook
Select Case Environ("Username")
Case "Alex", "Sommer"
Wb.Worksheets("Warnung").Visible = xlVeryHidden
Wb.Worksheets("Action").Visible = True
Case "Sabine", "Test", "Olaf", "e0109732"
Wb.Worksheets("Warnung").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = True
Case Else
MsgBox "Sie sind kein berechtigter User"
End Select
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Ausprobieren und Anpassen kriege ich dann sicherlich hin. Wäre toll.
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Wb
Stop
Set Wb = ThisWorkbook
On Error GoTo Fehler
Wb.Worksheets("Warnung").Visible = True
Wb.Worksheets("Action").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = xlVeryHidden
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Private Sub Workbook_Open()
Dim Wb, Wer As String
Stop 'kann weg
Set Wb = ThisWorkbook
Wer = Environ("Username")
On Error GoTo Fehler
If Wer = "e0109732" Or Wer = "Mueller" Or Wer = "Schmidt" Then
MsgBox "Fall 1"
Wb.Worksheets("Action").Visible = True
Wb.Worksheets("Warnung").Visible = xlVeryHidden
End If
If Wer = "e0109732" Or Wer = "Weber" Or Wer = "Meier" Then
MsgBox "Fall 2"
Wb.Worksheets("Action1").Visible = True
Wb.Worksheets("Warnung").Visible = xlVeryHidden
Else
MsgBox "Sie sind kein berechtigter User"
End If
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Gruß UweD
Private Sub Workbook_Open()
Call aus ' zum Testen, kann danach weg
Dim Wb, Wer As String
Dim Ja1 As String, Ja2 As String
Ja1 = "e0109732, Mueller, Schmidt, UweD"
Ja2 = "e0109732, Weber, Meier"
Stop 'kann weg
Set Wb = ThisWorkbook
Wer = Environ("Username")
'*** Testen
'Wer = "e0109732" ' beide
'Wer = "Keiner" ' nichts
'Wer = "Meier" ' Nur Action1
Wer = "Mueller" ' Nur Action
'Ende Testen
On Error GoTo Fehler
If InStr(Ja1, Wer) > 0 Then
MsgBox "Action ein"
Wb.Worksheets("Action").Visible = True
Wb.Worksheets("Warnung").Visible = xlVeryHidden
End If
If InStr(Ja2, Wer) > 0 Then
MsgBox "Action 1 ein"
Wb.Worksheets("Action1").Visible = True
Wb.Worksheets("Warnung").Visible = xlVeryHidden
End If
If InStr(Ja1 & Ja2, Wer) = 0 Then
MsgBox "Sie sind kein berechtigter User"
End If
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Sub aus()
Dim Wb
Set Wb = ThisWorkbook
On Error GoTo Fehler
Wb.Worksheets("Warnung").Visible = True
Wb.Worksheets("Action").Visible = xlVeryHidden
Wb.Worksheets("Action1").Visible = xlVeryHidden
Err.Clear
Fehler:
If Err.Number 0 Then MsgBox "Fehler: " & Err.Number & vbLf & Err.Description: Err. _
Clear
End Sub
Gruß UweD