Eingabe verunmöglichen, wenn mehrere Sheets aktiv

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next If ActiveWindow.SelectedSheets.Count > 1 Then With Application .EnableEvents = False If Not bUndo Then .Undo .EnableEvents = True End With bUndo = True MsgBox "Mehrere Tabellen aktiviert !!!" Application.EnableEvents = True Exit Sub End If bUndo = False End Sub

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) On Error Resume Next If ActiveWindow.SelectedSheets.Count > 1 Then If Not bUndo Then Application.EnableEvents = False Application.Undo bUndo = True MsgBox "Mehrere Tabellen aktiviert !!!" Application.EnableEvents = True Exit Sub End If End If bUndo = False End Sub

Hallo Peter,
gehe doch mal bitte die Logik deines Codes durch:
Wenn mehr als ein Sheet markiert ist, dann führe ein .Undo aus wenn bUndo falsch ist. Beim allerersten Mal ist es immer falsch.
Danach wird es auf wahr gesetzt und bleibt es auch. Erst wenn du nur ein Blatt markierst und dann eine Zelle in einem Blatt änderst (.Count = 1) wird bUndo wieder auf falsch gesetzt. Deine Prüfung ist damit solang nutzlos bis dein Benutzer dies auch wirklich gemacht hat, denn solang wird kein .Undo ausgeführt. Das heist entweder den Benutzer nochmals belehren, oder den Code für den Super-Dau rüsten.
Ich bin mir nicht sicher wofür bUndo gedacht war, so ganz erschließt sich mir der Sinn dahinter nämlich nicht, aber ich vermute es soll in diesem Code die Aufgabe übernehmen, dass deine MsgBox nicht 10x angezeigt wird wenn du 10 Tabellenblätter markiert hattest. Du änderst bei Mehrfachmarkierung von Tabellenblättern auf jedem Blatt eine Zelle und damit wird der Code für alle diese ausgeführt. Nach dem letzten muss er jedoch bUndo wieder auf falsch setzen, sonst bleibt er funktionslos. Das kann über einen Zähler erfolgen.
Probier bitte mal untenstehenden Code ob er deinen Vorstellungen entspricht.
lg Steve

Dim bUndo As Boolean
Dim i As Long
Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
If i = 0 Then i = ActiveWindow.SelectedSheets.Count
'On Error Resume Next
If i > 1 Then
With Application
.EnableEvents = False
If Not bUndo Then
.Undo
MsgBox "Mehrere Tabellen aktiviert !!!"
End If
.EnableEvents = True
End With
bUndo = True
Else
bUndo = False
End If
i = i - 1
End Sub

Option Explicit Dim iStrg%, iSheetsSelected% Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) If ActiveWindow.SelectedSheets.Count > 1 Then If iStrg >= iSheetsSelected - 1 And iStrg > 0 Then iStrg = 0 iSheetsSelected = 0 Exit Sub Else If iStrg = 0 Then Application.EnableEvents = False Application.Undo MsgBox "Mehrere Tabellen aktiviert !!!", vbCritical, "Fehler" Application.EnableEvents = True iSheetsSelected = ActiveWindow.SelectedSheets.Count End If iStrg = iStrg + 1 Exit Sub End If End If End Sub

Beliebteste Forumthreads (12 Monate)

Eingabe verunmöglichen, wenn mehrere Sheets aktiv

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

300 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Eingabe verunmöglichen, wenn mehrere Sheets aktiv

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

300 Forumthreads zu ähnlichen Themen

VBA Beispiele zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

7
Beiträge zum Forumthread

Beiträge zu diesem Forumthread