AW: Filter
16.07.2014 10:40:56
Nepumuk
Hallo,
der folgende Code muss in das Modul "DieseArbeitsmappe":
' **********************************************************************
' Modul: DieseArbeitsmappe Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************
Option Explicit
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim objLastActiveSheet As Object
If PrivilegedUser Then
Cancel = True
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
Set objLastActiveSheet = ActiveSheet
Worksheets("Eingeschränkt").Visible = xlSheetVisible
Worksheets("Original").Visible = xlSheetVeryHidden
Call Save
Worksheets("Original").Visible = xlSheetVisible
Worksheets("Eingeschränkt").Visible = xlSheetVeryHidden
objLastActiveSheet.Select
Saved = True
With Application
.EnableEvents = False
.ScreenUpdating = False
End With
End If
End Sub
Private Sub Workbook_Open()
If PrivilegedUser Then
Worksheets("Original").Visible = xlSheetVisible
Worksheets("Eingeschränkt").Visible = xlSheetVeryHidden
Else
With Worksheets("Eingeschränkt")
.Visible = xlSheetVisible
.UsedRange.ClearContents
End With
With Worksheets("Original")
If Not .AutoFilterMode Then Call .Rows(1).AutoFilter
With .AutoFilter
Call .Range.AutoFilter(Field:=2, Criteria1:="<>Projektleiter")
Call .Range.Copy(Destination:=Worksheets("Eingeschränkt").Cells(1, 1))
End With
Call .ShowAllData
.Visible = xlSheetVeryHidden
End With
With Worksheets("Eingeschränkt")
If Not .AutoFilterMode Then Call .Rows(1).AutoFilter
End With
End If
Saved = True
End Sub
Private Function PrivilegedUser() As Boolean
Select Case Environ$("USERNAME")
Case "Heidi", "Max" 'Die privilegierten User
PrivilegedUser = True
End Select
End Function
Namen der beiden Tabellen, bei mir "Eingeschränkt" und "Original", anpassen !!!
In dieser Zeile:
Case "Heidi", "Max" 'Die privilegierten User
musst du die Namen Heidi und Max durch die Anmeldenamen in Windows ersetzen. Die holst du dir am besten so: Öffne eine neue Excelmappe - Alt+F11 öffnet den VBA-Editor - in dessen Menüleiste - Einfügen - Modul. In diese Modul kopierst du folgende Routine:
Public Sub test()
Cells(1, 1).Value = Environ$("USERNAME")
End Sub
und drückst auf F5. Jetzt hast du in Zelle A1 den Anmeldenamen stehen. Den kopierst du und fügst ihn in den Code ein. Achtung, wenn du eine Excelzelle kopierst ist immer ein Zeilenumbruch am Ende. Also den Namen besser oben in der Bearbeitungszeile markieren und kopieren.
Gruß
Nepumuk
