2015-12-14 8 views
5

Sto tentando di scrivere un po 'di codice Visual Basic per impedire a chiunque di sovrascrivere accidentalmente le celle su più fogli quando sono selezionati più fogli.Creazione di un avviso in Excel quando si selezionano più pagine per evitare la sovrascrittura accidentale delle celle

Tuttavia, desidero l'opzione di sovrascrivere le celle su più fogli, qualora fosse necessario in qualsiasi momento.

Quindi, quando sono selezionati più fogli, desidero un pop-up con 2 opzioni, come segue: "Sei sicuro di voler sovrascrivere le celle tra i fogli che hai selezionato?" Ok Annulla

Penso di esserci quasi con il codice qui sotto, ma se ho 3 fogli selezionati, il pop-up apparirà 3 volte (una volta per ogni pagina). Naturalmente voglio solo che il pop up appaia una volta, indipendentemente dal numero di fogli che ho selezionato.

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 

O una soluzione ancora migliore sarebbe in realtà:

"Sei sicuro di voler sovrascrivere le cellule attraverso i fogli selezionati?"

Sì (per continuare con tutte le pagine selezionate),

No (per selezionare la pagina corrente e continua),

Annulla (per annullare l'operazione e mantenere la selezione corrente).

risposta

2

Questa soluzione convalida se il foglio di lavoro evento è il foglio di lavoro attivo in ordine di sparare la procedura di selezione multipla.

Anche se l'utente sceglie di aggiornare solo il foglio attivo, la procedura lascia tutti gli altri fogli inclusi nella selezione come erano prima dell'azione che ha attivato lo sfiato, invece dell'effetto indesiderato di inserire in tutte quelle celle il valore vbNullString

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

Questo codice è perfetto. Grazie mille!! :) – Michael

+0

Questo è quello che volevi che "No" modificasse solo il "foglio di lavoro", l'annullamento della cancellazione è l'effetto collaterale che non avevi previsto. Quanto sono indecisi i tuoi utenti? – EEM

1

Questo è molto complicato, poiché utilizzando l'evento Workbook_SheetChange il codice verrà generato per ogni istanza di una modifica del foglio di cui si deve tenere conto.

Tuttavia, con un uso furbo di variabili pubbliche da utilizzare come switch/contatore e una sub-routine separata per elaborare i casi in cui modificare tutti i fogli di lavoro attivi o no, ho sviluppato un codice che è stato accuratamente testato . Ho anche pesantemente commentato il mio codice per aiutare a capire la logica.

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

essere consapevoli che se l'utente seleziona 'No' questo codice cambia ancora le cellule in tutti gli altri fogli ... – EEM

+0

@EEM - Sì, mi rendo conto che ora, che il' vbNullString' non può essere il desiderato risultati se la cella avesse già un valore :(Ero quasi lì :) –

Problemi correlati