Passwort bei Spezialmenu öffnen

Forumthread: Passwort bei Spezialmenu öffnen

27.08.2006 14:47:26

Peter

Hallo Excelfreunde
Ist es möglich das Aufklappen eines Spezialmenus nur durch ein Passwort zu ermöglichen.
Das Ausführen der Macros dürfen nur Personen die Kenntniss des Passworts haben, durchführen.
Das Passwort soll bei jedem öffnen des Spezialmenus abgefragt werden.
Ich bnötige Hilfe wie und wo ich das einsetzen soll.
Gruß Peter

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Passwort bei Spezialmenu öffnen

Orakel

Hallo Peter,
meinst Du so?
Sub Makro1()
Dim strPW As String
Dim strEingabe As String
strPW = "123"
strEingabe = InputBox("Diese Funktion ist nur für den Entwickler des Programmes vorgesehen. Bitte identifizieren Sie sich mit der Eingabe des Passwortes:", "Passwort - Abfrage")
If strPW strEingabe Then
MsgBox "der Vorgang wurde unterbrochen (wurde das Passwort richtig eingegeben?)", vbExclamation
Else
MsgBox "Makro1"
End If
End Sub
Grüße
Orakel

AW: Passwort bei Spezialmenu öffnen

27.08.2006 16:02:50

Peter

Hallo Excelfreund
so ungefähr hatte ich mir das gedacht.
Nur leider weiss ich nicht wie und wo ich das einbauen soll?
Es soll beim öffnen des Spezialmenus eine Passwortabfrage eingebaut werden.
Ich Poste mal das Macro das ich mir zusammengebaut habe aus dem Vorum.
Hier soll die Passwortabfrage eingebaut werden:
Option Explicit
Private Const menueName As String = "Mein Spezialmenu"


Sub makeMenue()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarButton
deleteMenue
'Zuweisen der Objectvariablen
Set cbMenu = Application.CommandBars("Worksheet Menu Bar")
Set cbSpecialMenu = cbMenu.Controls.Add(Type:=msoControlPopup)
'Titelbeschriftung der Menübar
cbSpecialMenu.Caption = menueName
'Einen Button hinzufügen und diesen gleich beschriften
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Drucker auswählen"
.OnAction = ""
.FaceId = 1
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Aktiver Drucker"
.OnAction = "Makro16"
.FaceId = 4
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = "Drucker LPQ3"
.OnAction = "Makro17"
.FaceId = 4
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
.Style = msoButtonIconAndCaption
.Caption = ""
.OnAction = ""
.FaceId = 1
End With
Set cbMenu = Nothing
Set cbCommand = Nothing
Set cbSpecialMenu = Nothing
End Sub


Sub deleteMenue()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Delete
On Error GoTo 0
End Sub

Kannst du mir hierbei helfen.
Gruß Peter

AW: Passwort bei Spezialmenu öffnen

Orakel

Hallo Peter,
mein Vorschlag geht davon aus, dass Dein Menü unangetastet bleibt. Erst wenn Du eines der Untermenüs aufrufst, wird das Passwort abgefragt. Die Abfrage ist also in dem Makro eingebaut, das das Ereignis auslöst. Warum willst Du ein Passwort schon beim Start des des Menüs abfragen. Mein Vorschlag hat den Vorteil, eben je nach Anwenderkreis bestimmte Dinge auch zuzulassen. Ich lass mal offen, wenn Du einen anderen Weg gehen willst.
Grüße
Orakel

AW: Passwort bei Spezialmenu öffnen

27.08.2006 16:39:18

Peter

Hallo Excelfreund
ich hatte mir das so vorgestellt.
Jemand möchte das Spezialmenü öffnen.
Das kann er nur wenn das Passwort eingegeben wird.
Ist das Passwort "Richtig", kann er alle Funktionen unter dem Spezialmenu nutzen.
Währe das so möglich. ?
Gruß Peter

AW: Passwort bei Spezialmenu öffnen

27.08.2006 17:24:27

Josef

Hallo Peter!
Das geht meines Wissens nicht.
Du musst die Passwortfrage mit jedem Untermenüpunkt verknüpfen.
Beispiel: https://www.herber.de/bbs/user/36194.xls

Gruß Sepp

AW: Passwort bei Spezialmenu öffnen

Orakel

Hallo,
alternativ bei Nutzung alle oder keiner beim Start abfragen:
Private Sub Workbook_Activate()
Dim strPW As String
Dim strEingabe As String
strPW = "123"
strEingabe = InputBox("Für Angemeldete Sondernutzer des Programmes sind weitere Funktionen möglich. Bitte identifizieren Sie sich mit der Eingabe des Passwortes:", "Passwort - Abfrage")
If strPW <> strEingabe Then
MsgBox "Herlich willkommen in der Grundversion", vbExclamation
Else
makeMenue
End If
End Sub
Grüße
Orakel

AW: Passwort bei Spezialmenu öffnen

27.08.2006 18:32:03

Peter

Hallo Excelfreunde
jetz bin ich total verwirrt.
Ich weiss nicht mehr wo was hinkommt.
Ich habe beide Versionen versucht hinzubekommen aber ohne Erfolg.
Gruß Peter
Ich denke das muss ich wohl aufgeben.

AW: Passwort bei Spezialmenu öffnen

Orakel

Hallo Peter,
ich habe mal den Code von Sepp aus dem anderen Thread, entsprechend meiner Variante, als Datei eingestellt.
https://www.herber.de/bbs/user/36196.xls
Grüße
Orakel

AW: Passwort bei Spezialmenu öffnen

27.08.2006 19:41:36

Peter

Hallo Excelfreunde
sorry aber das ist mir zu umständlich. (16 mal Passwort eingeben.)
Bitte schaut euch mal das Spezialmenu an, hier sind 16 Funktionen hinterlegt die eigendlich nur ausgewählte Personen nutzen dürfen.
Mit dieser Datei werden Analysen erstellt, die nicht geändert werden dürfen.
Mit der letzten bereitgestellten Version (Oracle) ist das direkt beim öffnen zu umständlich.
Ich würde gerne beim öffnen (Anklicken) des Spezialmenus das Passwort abfragen und dann nicht mehr. Alle Funktionen können genutzt werden.
Vielleicht kann das jemand in diesen Code einbauen.!!!
Gruß Peter kurz vor der Pimpanella
https://www.herber.de/bbs/user/36197.xls

AW: Passwort bei Spezialmenu öffnen

27.08.2006 20:03:51

Josef

Hallo Peter!
Das was du willst geht nicht, zumindest nicht nach meinem Wissen!
Vielleicht ist das ein Kompromiss.

' **********************************************************************
' Modul: Modul8 Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Private Const menueName As String = "Dieters Spezialmenu"
Private Const strPW As String = "pw" ' dein Passwort - anpassen!

Sub makeMenue()
Dim cbMenu As CommandBar
Dim cbSpecialMenu As CommandBarPopup
Dim cbCommand As CommandBarButton

deleteMenue

'Zuweisen der Objectvariablen
Set cbMenu = Application.CommandBars("Worksheet Menu Bar")
Set cbSpecialMenu = cbMenu.Controls.Add(Type:=msoControlPopup)
'Titelbeschriftung der Menübar
cbSpecialMenu.Caption = menueName

'Einen Button hinzufügen und diesen gleich beschriften
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Menü aktivieren"
  .OnAction = "activateMenu"
  .FaceId = 343
End With

Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Einen Drucker auswählen"
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Aktiver Drucker"
  .OnAction = "Makro16"
  .FaceId = 4
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Drucken auf LPQ3"
  .OnAction = "Makro17"
  .FaceId = 4
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = ""
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Name in den Diagrammen ändern"
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "D.Thönnißen"
  .OnAction = "Makro35"
  .FaceId = 17
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "J.Rost"
  .OnAction = "Makro36"
  .FaceId = 17
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = ""
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Monate in den Diagrammen ändern"
  .OnAction = ""
  .FaceId = 1
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Januar"
  .OnAction = "Makro1"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Februar"
  .OnAction = "Makro2"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "März"
  .OnAction = "Makro3"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "April"
  .OnAction = "Makro6"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Mai"
  .OnAction = "Makro7"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Juni"
  .OnAction = "Makro8"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Juli"
  .OnAction = "Makro4"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "August"
  .OnAction = "Makro5"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "September"
  .OnAction = "Makro9"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Oktober"
  .OnAction = "Makro10"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "November"
  .OnAction = "Makro11"
  .FaceId = 16
  .Enabled = False
End With
Set cbCommand = cbSpecialMenu.Controls.Add(Type:=msoControlButton)
With cbCommand
  .Style = msoButtonIconAndCaption
  .Caption = "Dezember"
  .OnAction = "Makro12"
  .FaceId = 16
  .Enabled = False
End With

Set cbMenu = Nothing
Set cbCommand = Nothing
Set cbSpecialMenu = Nothing

End Sub

Sub deleteMenue()
On Error Resume Next
Application.CommandBars("Worksheet Menu Bar").Controls(menueName).Delete
On Error GoTo 0
End Sub

Private Sub activateMenu()
Dim objCntrl As CommandBarControl

If InputBox("Passwort:", "Passwort") = strPW Then
  For Each objCntrl In Application.CommandBars.ActionControl.Parent.Controls
    objCntrl.Enabled = True
  Next
  With Application.CommandBars.ActionControl
    .FaceId = 342
    .Enabled = False
  End With
Else

  MsgBox "Falsches Passwort!", 64, "Fehler"

End If
End Sub

Gruß Sepp

AW: Passwort bei Spezialmenu öffnen

27.08.2006 20:11:15

Peter

Hallo Excelfreunde
genau so habe ich mir das vorgestellt.
Es scheint hin und wieder doch noch die Sonne.
Vielen dank für eure Hilfe.
Sepp und Orakel ihr kommt in meine Favotiten.
Peter aus Aachen

AW: schön das es klappt...

Orakel

aber sepp ist einfach unerreicht.
:-))

Beliebteste Forumthreads (12 Monate)

Forumthread: Passwort bei Spezialmenu öffnen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread