Obbligare compilazione di celle excel

[tony1984]

Ciao a tutti,
avrei un paio di domande su come risolvere un problema su un file Excel che ho creato.
Vorrei impedire il salvataggio o la chiusura del file se alcune celle non sono state compilate, dando magari anche un messaggio di errore sul salvataggio o sulla chiusura del file stesso, impedendo così che venga dimenticato di compilare campi del foglio Excel molto importanti.
E' possibile farlo?

Grazie

[BG66]

Ciao Tony,
guarda se questi threads possono esserti d'aiuto:
http://www.pc-facile.com/forum/viewtopic.php?t=94737
http://www.pc-facile.com/forum/viewtopic.php?t=89507

Alla prossima

[tony1984]

Grazie, ma purtroppo ho ancora qualche difficoltà.
Faccio esempio pratico:
Vorrei che ad ogni salvataggio o tentativo di chiusura del file controlli se le celle "K4;H7;J7;H12;J12" siano state compilate se "A4>0".
Se non sono state compilate fare uscire un popup con messaggio di errore "Controllare celle X, Y e Z".
E' possibile?

grazie

[Anthony47]

Dal tuo file Excel, premere Alt-F11 per aprire l'editor delle macro.
Localizza nel frame "Progetto-VBAProject" di sinistra la voce QuestaCartellaDiLavoro e fai doppioclick; nel frame vuoto di dx inserire questo codice:

Codice: Seleziona tutto

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
With Sheets("Foglio2")                            '<<< Quale foglio Controllare
    If Range("A4") > 0 Then
        If Range("K4") = "" Then                  '<<< Quali celle controllare
            MsgBox ("Compilare K4 in " & .Name & vbCrLf & "File NON SALVATO")
            Cancel = True: Exit Sub
        End If
        If Range("H7") = "" Then                  '<<< Quali celle controllare
            MsgBox ("Compilare H7 in " & .Name & vbCrLf & "File NON SALVATO")
            Cancel = True: Exit Sub
        End If
'aggiungere altri CASI usando la stessa sintassi   <<<
   
    End If
End With
End Sub


Personalizzare le righe marcate <<< e il testo dei messaggi che si vuo far comparire.
In questo modo il salvataggio del fil non sara' consentito se A4 > 0 e le altre celle non sono compilate.
Non vedo perche' invece impedire di uscire dal file senza salvarlo.

Ciao

[tony1984]

alla grande.
grazie mille

[tony1984]

Ci sarebbe un modo più "carino" di scrivere questo codice?

Codice: Seleziona tutto

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
With Sheets(Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31"))
    If Range("A4") > 0 Then
        If Range("K4") = "" Then
            MsgBox ("Compilare campo CONDUTTORE")
            Cancel = True: Exit Sub
        End If
        If Range("Q4") = "" Then
            MsgBox ("Compilare campo TURNO")
            Cancel = True: Exit Sub
        End If
        If Range("A5") > 0 Then
            If Range("H7") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J7") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A10") > 0 Then
            If Range("H12") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J12") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A15") > 0 Then
            If Range("H17") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J17") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A20") > 0 Then
            If Range("H22") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J22") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A25") > 0 Then
            If Range("H27") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J27") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A30") > 0 Then
            If Range("H32") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J32") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
    End If
    If Range("A35") > 0 Then
        If Range("K35") = "" Then
            MsgBox ("Compilare campo CONDUTTORE")
            Cancel = True: Exit Sub
        End If
        If Range("Q35") = "" Then
            MsgBox ("Compilare campo TURNO")
            Cancel = True: Exit Sub
        End If
        If Range("A36") > 0 Then
            If Range("H38") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J38") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A40") > 0 Then
            If Range("H42") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J42") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A45") > 0 Then
            If Range("H47") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J47") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A50") > 0 Then
            If Range("H52") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J52") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A55") > 0 Then
            If Range("H57") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J57") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
        If Range("A60") > 0 Then
            If Range("H62") = "" Then
                MsgBox ("Compilare campo POSTAZIONE CONDUTTORE")
                Cancel = True: Exit Sub
            End If
            If Range("J62") = "" Then
                MsgBox ("Compilare campo NOME CONDUTTORE")
                Cancel = True: Exit Sub
            End If
        End If
    End If
End With
End Sub


Inoltre sarebbe una figata se riuscissi a spostare il cursore sulla cella dell'errore ed anche colorarla di rosso.
si può fare?

[Anthony47]

Ti segnalo che il codice che hai pubblicato lavorera' solo sul file che e' selezionato al momento dell'esecuzione macro.

Se vuoi sondare tutti i fogli dovrai indirizzarli uno per uno; se vuoi selezionare la cella da compilare allora dovrai selezionarla.
Se vuoi colorare in rosso una cella non compilata allora ti suggerisco di farlo tramite "Formattazione condizionale" usando la formula appropriata. Es per K4 userai la formula

Codice: Seleziona tutto

=E($A$4>0;K4="")

La stessa formattazione puoi copiarla su Q4

Per H7 userai invece

Codice: Seleziona tutto

=E($A$4>0;$A$5>0;H7="")

La stessa formattazione puoi copiarla su J7

E cosi' via per le altre celle. Tra l'altro questo rendera' piu' evidente all'utente gia' durante la compilazione che certe celle sono da guardare meglio.


Quindi invece che un sistema piu' carino ti propino questa bozza piu' funzionante:

Codice: Seleziona tutto

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Mess As String, cSh
'
Mess = "Compilare Cella!"
Application.ScreenUpdating = False
For Each cSh In Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", _
  "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")
    Sheets(cSh).Select
    If Range("A4") > 0 Then
        ccell = "K4"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        ccell = "Q4"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        If Range("A5") > 0 Then
            ccell = "H7"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J7"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
'
'tutte le altre condizioni
'tutte le altre condizioni
'tutte le altre condizioni
'
    End If
Next cSh
'fine:
Usci:
Application.ScreenUpdating = True
End Sub


Le uniche migliorie riguardano il messaggio che e' standard per ogni cella in errore (infatti sono sicuro che sul foglio ci sono gia' le indicazioni di quale parametro si tratti), e la standardizzazione del blocco di controllo (If Range(ccell) = "" Then / End If) che quindi puo' essere replicato con semplice Copia /Incolla.

Certamente si potrebbe fare una struttura meno enumerativa e piu' dichiarativa, ma questo richiederebbe un livello di astrazione difficile per me da spiegare sul forum.

Ciao

[tony1984]

Ottimo!!!
solo una cosa, quando salvo e compila la macro, mi va sull'ultimo foglio, il "31". E' possibile che alla fine del controllo mi rimanga sul foglio attivo?

grazie

[Anthony47]

Per tornare al foglio inizialmente attivo, incastra le istruzioni marcate +++ in queste due posizioni:

Codice: Seleziona tutto

Mess = "Compilare Cella!"
Csh=activesheet.name                           '+++
Application.ScreenUpdating = False


Codice: Seleziona tutto

Usci:
Sheets(Csh).Select                             '+++
Application.ScreenUpdating = True

Ciao

[tony1984]

ho fatto come mi hai detto Anthony47 ma purtroppo mi da un errore.
incollo qui di seguito il codice:

Codice: Seleziona tutto

Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Mess As String, cSh
Mess = "Compilare Cella!"
cSh = ActiveSheet.Name
Application.ScreenUpdating = False
For Each cSh In Array("1", "2", "3", "4", "5", "6", "7", "8", "9", "10", "11", "12", "13", "14", "15", "16", _
  "17", "18", "19", "20", "21", "22", "23", "24", "25", "26", "27", "28", "29", "30", "31")
    Sheets(cSh).Select
    If Range("A4") > 0 Then
        ccell = "K4"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        ccell = "Q4"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        If Range("A5") > 0 Then
            ccell = "H7"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J7"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A10") > 0 Then
            ccell = "H12"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J12"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A15") > 0 Then
            ccell = "H17"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J17"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A20") > 0 Then
            ccell = "H22"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J22"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A25") > 0 Then
            ccell = "H27"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J27"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A30") > 0 Then
            ccell = "H32"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J32"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
    End If
    If Range("A35") > 0 Then
        ccell = "K35"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        ccell = "Q35"
        If Range(ccell) = "" Then
            Range(ccell).Select
            MsgBox Mess
            Cancel = True: GoTo Usci
        End If
        If Range("A36") > 0 Then
            ccell = "H38"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J38"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A41") > 0 Then
            ccell = "H43"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J43"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A46") > 0 Then
            ccell = "H48"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J48"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A51") > 0 Then
            ccell = "H53"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J53"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A56") > 0 Then
            ccell = "H58"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J58"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A61") > 0 Then
            ccell = "H63"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J63"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A66") > 0 Then
            ccell = "H68"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J68"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A71") > 0 Then
            ccell = "H73"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J73"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
        If Range("A76") > 0 Then
            ccell = "H78"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
            ccell = "J78"
            If Range(ccell) = "" Then
                MsgBox Mess
                Range(ccell).Select
                Cancel = True: GoTo Usci
            End If
        End If
    End If
Next cSh
Usci:
Sheets(cSh).Select
Application.ScreenUpdating = True
End Sub


grazie ciao

[Anthony47]

Eh eh, poca fantasia nella scelta dei nomi delle variabili... Invece di cSh (che e' un nome gia' utilizzato per altri scopi) usiamo un nome diverso, quindi

Codice: Seleziona tutto

iSheet = ActiveSheet.Name


Codice: Seleziona tutto

Sheets(iSheet).Select

Pero' la prossima volta spiega quale errore e su quale istruzione...

Ciao