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ß UweDDie erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen