Live-Forum - Die aktuellen Beiträge
Anzeige
Archiv - Navigation
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
796to800
796to800
Aktuelles Verzeichnis
Verzeichnis Index
Verzeichnis Index
Übersicht Verzeichnisse
Inhaltsverzeichnis

Passwort bei Spezialmenu öffnen

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

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
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

Anzeige
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.
:-))

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige