VBA Abfrage Passwort

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

' ********************************************************************** ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim strPW As String, objRng As Range On Error GoTo ErrorHandler Application.EnableEvents = False If Not Intersect(Target, Range("C3:H100")) Is Nothing Then For Each objRng In Intersect(Target, Range("C3:H100")) If Application.CountIf(objRng.EntireColumn, "x") > 2 Then strPW = InputBox("Die Anzahl wird überschritten!" & vbLf & vbLf & _ "Um den Eintrag vornehmen zu können, müssen Sie das Passort eingeben!", "Passwort") If strPW <> cstrPW Then Application.Undo objRng = "" objRng.Select Exit For End If End If Next End If ErrorHandler: Application.EnableEvents = True End Sub ' ********************************************************************** ' Modul: Modul1 Typ: Allgemeines Modul ' ********************************************************************** Option Explicit Public Const cstrPW = "test" 'Passwort

Hallo Thomas,
warum dauernd wechselnde Bedingungen und andere Spalten?

' **********************************************************************
' Modul: Tabelle1  Typ: Element der Mappe(Sheet, Workbook, ...)
' **********************************************************************

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
Dim strPW As String, objRng As Range

On Error GoTo ErrorHandler
Application.EnableEvents = False

If Not Intersect(Target, Range("C3:H100")) Is Nothing Then
  For Each objRng In Intersect(Target, Range("C3:H100"))
    If LCase(objRng) = "x" And Application.CountIfs(Columns(objRng.Column), "x", Columns(6), "Lager") > 2 Then
      strPW = InputBox("Die Anzahl wird überschritten!" & vbLf & vbLf & _
        "Um den Eintrag vornehmen zu können, müssen Sie das Passort eingeben!", "Passwort")
      If strPW <> cstrPW Then
        Application.Undo
        objRng = ""
        objRng.Select
        Exit For
      End If
    End If
  Next
End If

ErrorHandler:
Application.EnableEvents = True
End Sub

' **********************************************************************
' Modul: Modul1  Typ: Allgemeines Modul
' **********************************************************************

Option Explicit

Public Const cstrPW = "test" 'Passwort

Gruß Sepp

' ********************************************************************** ' Modul: Tabelle1 Typ: Element der Mappe(Sheet, Workbook, ...) ' ********************************************************************** Option Explicit Private Sub Worksheet_Change(ByVal Target As Range) Dim strPW As String, objRng As Range On Error GoTo ErrorHandler Application.EnableEvents = False If Not Intersect(Target, Range("C3:H100")) Is Nothing Then For Each objRng In Intersect(Target, Range("C3:H100")) If LCase(objRng) = "x" And Application.CountIf(objRng.EntireColumn, "x") > 2 Then strPW = InputBox("Die Anzahl wird überschritten!" & vbLf & vbLf & _ "Um den Eintrag vornehmen zu können, müssen Sie das Passort eingeben!", "Passwort") If strPW <> cstrPW Then Application.Undo objRng = "" objRng.Select Exit For End If End If Next End If ErrorHandler: Application.EnableEvents = True End Sub

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

VBA Abfrage Passwort

11 Beiträge zum Forumthread Beiträge zu diesem Forumthread

18 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Links zu Excel-Dialogen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

11
Beiträge zum Forumthread

Beiträge zu diesem Forumthread