Pro User eine Tabellenansicht ohne Veränderungsmöglichkeit
07.02.2024 15:05:03
Angelo
aktuell arbeite ich an einer Datei, in der Mitarbeiterdaten enthalten sind. Diese Datei befindet sich auf SharePoint und wird von mehreren Benutzern gleichzeitig verwendet. Es ist jedoch nicht gewünscht, dass jeder Benutzer alle Daten einsehen kann; stattdessen sollen nur bestimmte Teile eines Tabellenblatts für jeden Benutzer sichtbar sein. Mein Ansatz ist es, die Tabellenansichtsfunktion zu nutzen, indem ich für jeden Benutzer beim Öffnen der Datei eine eigene Tabellenansicht erstelle, die seinen Benutzernamen trägt.
Bis hierhin funktioniert alles wie geplant. Nun stehe ich jedoch vor folgenden Herausforderungen:
In der beigefügten Beispieldatei habe ich diesen Prozess vereinfacht dargestellt und die Tabellenansichten entsprechend erstellt. Leider habe ich bisher keinen Erfolg dabei gehabt, die gewünschten Einschränkungen umzusetzen. Ich frage mich daher, ob mein Ansatz der richtige ist und ob es überhaupt möglich ist, dies in Excel zu realisieren.
Ich habe versucht, die Funktionen der Tabellenansicht im Menüband abzufangen und zu nutzen, um Kontrollen zu implementieren, die Änderungen überwachen. Dafür habe ich entsprechend der im Internet gefundenen Anleitungen die XML-Datei und den VBA-Code angepasst und eingefügt. Leider war dies bisher nicht erfolgreich.
Vielleicht kann jemand hier erkennen, wo mein Ansatz falsch ist, oder mir einen Ratschlag geben, wie ich mein Ziel erreichen kann.
Die Beispieldatei im .xlsm-Format zeigt meinen aktuellen Stand, wie ich die Tabellenansichten erstelle und versuche, die Funktion abzufangen.
https://www.herber.de/bbs/user/166858.xlsx
Hier ist ein Auszug aus der XML-Datei sowie dem VBA-Code in der Datei.
xml:
""customUI xmlns=""">http://schemas.microsoft.com/office/2009/07/customui"">"
""ribbon">"
""tabs">"
""tab idMso="TabView"">"
""group idMso="GroupNamedSheetView" label="Sheet View"">"
""comboBox idMso="SheetViewComboBox" label="View:" onChange="BeispielAnsicht.xlsm!OnSheetViewComboBoxChange"/">"
""button idMso="KeepTemporarySheetView" label="Keep Temporary View" onAction="BeispielAnsicht.xlsm!OnKeepTemporarySheetView"/">"
""button idMso="ExitSheetView" label="Exit Sheet View" onAction="BeispielAnsicht.xlsm!OnExitSheetView"/">"
""button idMso="NewSheetView" label="New Sheet View" onAction="BeispielAnsicht.xlsm!OnNewSheetView"/">"
""button idMso="SheetViewOptions" label="Sheet View Options" onAction="BeispielAnsicht.xlsm!OnSheetViewOptions"/">"
""/group">"
""/tab">"
""/tabs">"
""/ribbon">"
""backstage onHide="BeispielAnsicht.xlsm!OnHide" onShow="BeispielAnsicht.xlsm!OnShow"">"
""!-- Backstage Ribbon XML --">"
""/backstage">"
""/customUI">"
DieseArbeitsmappe:
Private Sub Workbook_BeforeClose(Cancel As Boolean)
Dim Benutzer As String
Dim WB As Workbook
Dim WS As Worksheet
Dim WS_Count As Integer
Dim i As Integer
On Error Resume Next
Set WB = ThisWorkbook
Benutzer = Environ("username")
WS_Count = WB.Worksheets.Count
For i = 1 To WS_Count
Set WS = WB.Worksheets(i)
With WS
.NamedSheetViews.GetItem("Full").Activate
.NamedSheetViews.GetItem(Benutzer).Delete
.Range(.UsedRange.Address).Select
.ShowAllData
End With
Set WS = Nothing
Next i
Set WB = Nothing
End Sub
Private Sub Workbook_Open()
Dim Benutzer As String
Dim WB As Workbook
Dim WS As Worksheet
Dim WS_Count As Integer
Dim i As Integer
On Error Resume Next
Aktiv = True
Set WB = ThisWorkbook
Benutzer = Environ("username")
WS_Count = WB.Worksheets.Count
For i = 1 To WS_Count
Set WS = WB.Worksheets(i)
If WS.Name = "Rechte" Then
WS.Range("A5").Value = Benutzer
WS.Select
Else
With WS
.Select
.NamedSheetViews.GetItem("Full").Activate
.NamedSheetViews.GetItem(Benutzer).Delete
.NamedSheetViews.EnterTemporary
.NamedSheetViews.GetItem("").Name = Benutzer
.NamedSheetViews.GetItem(Benutzer).Activate
.Range(.UsedRange.Address).Select
.Range(.UsedRange.Address).AutoFilter Field:=1, Criteria1:="1"
End With
End If
Set WS = Nothing
Next i
Set WB = Nothing
Aktiv = False
Tabelle4.Select
End Sub
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Modul1:
Option Explicit
Public Aktiv As Boolean
Public Sub OnSheetViewComboBoxChange(control As IRibbonControl, text As String)
MsgBox "Sheet View ComboBox geändert. Neue Auswahl: " & text, vbInformation, "Hinweis"
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Public Sub OnKeepTemporarySheetView(control As IRibbonControl)
MsgBox "Keep Temporary Sheet View gedrückt.", vbInformation, "Hinweis"
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Public Sub OnExitSheetView(control As IRibbonControl)
MsgBox "Exit Sheet View gedrückt.", vbInformation, "Hinweis"
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Public Sub OnNewSheetView(control As IRibbonControl)
MsgBox "New Sheet View gedrückt.", vbInformation, "Hinweis"
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Public Sub OnSheetViewOptions(control As IRibbonControl)
MsgBox "Sheet View Options gedrückt.", vbInformation, "Hinweis"
SheetView_On ThisWorkbook.ActiveSheet.Name
End Sub
Sub OnHide(control)
If ActiveWorkbook.Name > ThisWorkbook.Name Then Exit Sub
MsgBox "Dateimenü geschlossen.", 64, "Hinweis"
End Sub
Sub OnShow(control)
If ActiveWorkbook.Name > ThisWorkbook.Name Then Exit Sub
MsgBox "Dateimenü aufgerufen.", 64, "Hinweis"
End Sub
Sub SheetView_On(TB As String)
Dim Benutzer As String
Dim WB As Workbook
Dim WS As Worksheet
Dim ActiveSheetView As String
Dim View As NamedSheetViewCollection
On Error Resume Next
If Aktiv = True Then Exit Sub
If ActiveSheet.Name = "Rechte" Then Exit Sub
Set WB = ThisWorkbook
Set WS = WB.Worksheets(TB)
Set View = WS.NamedSheetViews
ActiveSheetView = View.GetActive.Name
Benutzer = Environ("username")
WS.NamedSheetViews.GetItem(Benutzer).Activate
WS.Range(WS.UsedRange.Address).Select
WS.Range(WS.UsedRange.Address).AutoFilter Field:=1, Criteria1:="1"
Set View = Nothing
End Sub
Danke für eure Hilfe!!