Kontextmenü userabhängig? VBA

Hi,
ich komme einfach nicht klar mit meinem Problem. Vielleicht kann mir hier bei den Profis jemand helfen. Hab schon das ganze Netz durchsucht und nichts gefunden, was ich verwerten kann.
In einer Arbeitstabelle möchte ich userabhängig ein Kontextmenü definieren
dazu habe ich in einer anderen Tabelle (Berechtigungen) die gültigen Usernamen eingetragen.
Nach Einlesen des Users (erfolgt im Modul) [UserID = environ("UserName")] soll die Berechtigung des Users überprüft nun das entsprechende Kontextmenü "installiert" werden.
[Sub Routinen in Modul: KM1() für berechtigte User, KM2() für nicht berechtigte User]
das bestehende Kontextmenü wird gelöscht und durch das neue ersetzt (die beiden Routinen laufen einwandfrei)
In der "Right_click"-Routine in der Arbeitstabelle müsste dazu quasi der Aufruf des Kontextmenümakros je nach Berechtigung geändert werden.
Hat jemand eine Idee?

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Sub AutoLogIn() Dim User As Range Dim UserID$ Dim OK as Variant UserID = Environ("UserName") 'User mit Liste vergleichen With Application.Worksheets("Userliste").Range("A5:A") Set OK = .Find(UserID, Lookin:=xlValues) End With If Not OK Is Nothing Then 'In Worksheet_BeforeRightClick Makro auf KM1 setzen ????? KM1 MsgBox "User: " & UserID & " " & vbCr & _ "ist berechtigt, Änderungen vorzunehmen," & vbCr & _ "und die Datei zu speichern!" & vbCr & vbCr & _ "Bearbeitung über Kontextmenü (rechte Maustaste)", vbOKOnly + vbInformation, "Hinweis" End If Else 'In Worksheet_BeforeRightClick Makro auf KM1 setzen ????? KM2 MsgBox "User: " & UserID & " " & vbCr & _ "hat keine Berechtigung Änderungen vorzunehmen," & vbCr & _ "oder die Datei zu speichern!" & vbCr & vbCr & _ "Steuerung über Kontextmenü (rechte Maustaste)", vbOKOnly + vbInformation, "Hinweis" End If End Sub

Sub KM1() Dim NeuesMenü As CommandBarButton With CommandBars("Cell") 'Bestehendes Menü löschen Do While .Controls.Count > 0 On Error Resume Next .Controls(1).Delete Loop 'Neues Menü erstellen Set NeuesMenü = .Controls.Add(msoControlButton) With NeuesMenü .Caption = "&Makroaufruf" .OnAction = "Mein_Makro" End With Set NeuesMenü = .Controls.Add(msoControlButton) With NeuesMenü .Caption = "&Info" .OnAction = "Info_Fenster" .FaceId = 487 End With With CommandBars("cell") .Controls(.Controls.Count).BeginGroup = True End With End With End Sub

Hallo Hans,
danke für die Antwort, im Grunde möchte ich es ja so machen, nur mit dem Unterschied, dass ich die eigentlichen "Arbeits-Makros" gerne in einem Modul zusammengefasst lassen möchte und in der Arbeitstabelle nur den Makroaufruf einfügen möchte. Nachfolgend, wie dieser Bereich aussieht:
Wie du vorgeschlagen hast:
--------------------------
Die Prüfung der Berechtigung im Workbook_Open-Ereignis
Im WorkbookBeforeClose-Ereignis das Kontextmenü wieder löschen,
(ich habe zusätzlich noch das Workbook_WindowDeactivate-Ereignis)
Diese Arbeitsmappe:
-------------------


Private Sub Workbook_Open()
AutoLogIn
End Sub


Private Sub Workbook_WindowDeactivate(ByVal Wn As Excel.Window)
Application.CommandBars("Cell").Reset
End Sub


Private Sub Workbook_BeforeClose(Cancel As Boolean)
Application.CommandBars("Cell").Reset
End Sub

Nächster Vorgang:
-----------------
Im BeforeRightClick-Ereignis des Arbeitsblattes den Aufruf des neuen Kontextmenüs verankern
Arbeitstabelle:
---------------


Private Sub Worksheet_BeforeRightClick(ByVal Target As Excel.Range, Cancel As Boolean)
Kontextmenü_Makro
End Sub

Und hier mein Problem:
----------------------
Das Anlegen eines neuen Kontextmenüs, in Abhängigkeit der Berechtigung
Allgemeines Modul:
------------------
Sub AutoLogIn()
Dim User As Range
Dim UserID$
Dim OK As Variant
UserID = Environ("UserName")
'User mit Liste vergleichen
With Application.Worksheets("Feiertage").Range("A5:A20")
Set OK = .Find(UserID, LookIn:=xlValues)
End With
If Not OK Is Nothing Then
'In Worksheet_BeforeRightClick Makroaufruf mit Kontext_Menü,
'Kontext_Menü = KM1 setzen

MsgBox "User: " & UserID & " " & vbCr & _
"ist berechtigt, Änderungen vorzunehmen," & vbCr & _
"und die Datei zu speichern!" & vbCr & vbCr & _
"Bearbeitung über Kontextmenü (rechte Maustaste)", vbOKOnly + vbInformation, "Hinweis"
Else
'In Worksheet_BeforeRightClick Makroaufruf mit Kontext_Menü,
'Kontext_Menü = KM2 setzen

MsgBox "User: " & UserID & " " & vbCr & _
"hat keine Berechtigung Änderungen vorzunehmen," & vbCr & _
"oder die Datei zu speichern!" & vbCr & vbCr & _
"Steuerung über Kontextmenü (rechte Maustaste)", vbOKOnly + vbInformation, "Hinweis"
End If
End Sub

Sub KM1()
...
End Sub

Sub KM2()
...
End Sub

Gruß Peter

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Kontextmenü userabhängig? VBA

7 Beiträge zum Forumthread Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread