2015-12-14 2 views
5

Ich versuche ein wenig Visual Basic-Code zu schreiben, um zu verhindern, dass versehentlich Zellen über mehrere Blätter hinweg überschrieben werden, wenn mehrere Blätter ausgewählt sind.Erstellen einer Warnung in Excel, wenn mehrere Seiten ausgewählt sind, um versehentliches Überschreiben von Zellen zu verhindern

Ich möchte jedoch die Möglichkeit, Zellen über mehrere Blätter hinweg zu überschreiben, sollte dies zu irgendeinem Zeitpunkt erforderlich sein.

Also, wenn ich mehrere Blätter ausgewählt habe, möchte ich ein Popup mit 2 Optionen, wie folgt: "Sind Sie sicher, dass Sie die Zellen über die Blätter, die Sie ausgewählt haben, überschreiben?" OK Abbrechen

Ich denke, ich bin fast da mit dem Code unten, aber wenn ich 3 Blätter ausgewählt habe, erscheint das Popup 3 Mal (einmal für jede Seite). Natürlich möchte ich nur das Popup einmal erscheinen lassen, egal wie viele Blätter ich ausgewählt habe.

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    If ActiveWindow.SelectedSheets.Count > 1 Then 
    If MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected?", vbOKCancel) = vbCancel Then Exit Sub 
     Application.EnableEvents = False 
     Application.Undo 
    End If 
    Application.EnableEvents = True 
End Sub 

Oder eine noch bessere Lösung wäre tatsächlich sein:

„Sind Sie sicher, dass Sie die Zellen über die Blätter zu überschreiben möchten, dass Sie gewählt haben?“

Ja (mit allen ausgewählten Seiten, um fortzufahren),

Nein (aktuelle Seite wählen und weiter),

Abbrechen (Vorgang abzubrechen und aktuelle Auswahl halten).

Antwort

2

Diese Lösung überprüft, ob das Ereignisarbeitsblatt das aktive Arbeitsblatt ist, um das Mehrfachauswahlverfahren auszulösen.

Wenn der Benutzer nur das aktive Blatt aktualisiert, werden alle anderen Blätter in der Auswahl so belassen, wie vor der Aktion, die die Entlüftung ausgelöst hat, anstelle des unerwünschten Effekts, den Wert vbNullString einzugeben

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 
    Application.EnableEvents = False 
    If Sh.Name = ActiveSheet.Name Then Call Wsh_MultipleSelection(Target) 
    Application.EnableEvents = True 
End Sub 

Private Sub Wsh_MultipleSelection(ByVal rTrg As Range) 
Const kTtl As String = "Selection Across Multiple Sheets" 
Const kMsg As String = "You are trying to overwrite cells across multiple sheets." & vbLf & _ 
    "Press [Yes] if you want to continue and overwrite the selected cells" & vbLf & _ 
    "Press [No] if you want to overwrite selected cells in active sheet only" & vbLf & _ 
    "Press [Cancel] to undo last action." 
Const kBtt As Long = vbApplicationModal + vbQuestion + vbYesNoCancel + vbDefaultButton3 

Dim iResp As Integer 
Dim vCllVal As Variant 
Dim bWshCnt As Byte 

    bWshCnt = ActiveWindow.SelectedSheets.Count 
    If bWshCnt > 1 Then 
     bWshCnt = -1 + bWshCnt 
     iResp = MsgBox(kMsg, kBtt, kTtl) 
     Select Case iResp 
     Case vbYes 
      Rem NO ACTION! 
     Case vbNo: 
      Rem Select Only Active Sheet 
      vCllVal = rTrg.Cells(1).Value2 
      Application.Undo 
      rTrg.Value = vCllVal 
     Case Else 
      Rem Cancel 
      Application.Undo 
    End Select: End If 
End Sub 
+0

Dieser Code ist perfekt. Vielen Dank!! :) – Michael

+0

Das ist, was Sie wollten, dass 'Nein' nur das' activesheet' ändert, die Annullierung des Undo ist der Nebeneffekt, den Sie nicht erwartet haben. Wie unentschlossen sind Ihre Nutzer? – EEM

1

Dies ist sehr schwierig, da der Code bei Verwendung des Ereignisses für jede Instanz einer Blattänderung ausgelöst wird, die Sie berücksichtigen müssen.

Allerdings mit einigen geschickten Verwendung von öffentlichen Variablen als Schalter/Zähler und eine separate Unterroutine zu verarbeiten, welche Fälle alle gegen aktive vs keine Arbeitsblätter zu ändern, habe ich Code entwickelt, der gründlich getestet wurde . Ich habe meinen Code auch stark kommentiert, um die Logik zu verstehen.

Option Explicit 

Dim bAsked As Boolean 
Dim dRet As Double 
Dim iCnt As Long 

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range) 

    Application.EnableEvents = False 

    Dim lSheets As Long 

    lSheets = ActiveWindow.SelectedSheets.Count 

    If lSheets > 1 Then Check lSheets, Sh, Target 

    Application.EnableEvents = True 

End Sub 

Sub Check(iTotal As Long, ws As Worksheet, rng As Range) 

'use this is a counter to count how many times the sub has been called in the firing of the 'Workbook_SheetChange` event 
iCnt = iCnt + 1 

'if the question has not been asked yet (first time event is fired) 
If Not bAsked Then 

    dRet = MsgBox("Are you sure you want to overwrite the cells across the sheets you have selected? Click Yes to overwrite all sheets, No to overwrite the Active Sheet, or Cancel to abort the entire overwrite.", vbYesNoCancel) 

    bAsked = True 'set to true so question will only be asked once on event firing 

End If 


'dRet will always be the same for each instance an event is fired 
Select Case dRet 

    Case Is = vbYes 

     'set the value for each range to what user entered 
     ws.Range(rng.Address) = rng.Value2 

    Case Is = vbNo 

     'only set the value the user entered to the active worksheet (the one the user is on) 
     If ActiveSheet.Name = ws.Name Then 
      ws.Range(rng.Address) = rng.Value2 
     Else 
      ws.Range(rng.Address) = vbNullString 
     End If 

    Case Is = vbCancel 

     'do not set any values on any sheet 
     Application.Undo 

End Select 

'if the total times the sub has been called is equal to the total selected worksheet reset variables so they work next time 
'if the count equals the total it's the last time the sub was called which means its the last sheet 
If iCnt = iTotal Then 
    bAsked = False 
    iCnt = 0 
End If 

End Sub 
+0

beachten Sie, dass, wenn der Benutzer 'No' dieser Code noch die Zellen in allen anderen Blättern ändert ... – EEM

+0

@EEM - Ja, ich weiß jetzt, dass, dass die' vbNullString' nicht die gewünschte sein kann Ergebnisse, wenn die Zelle bereits einen Wert hatte :(Ich war fast da :) –

Verwandte Themen