data obbligatoria

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

La macro allegata se manca la data nella colonna B e scrivo nel range B:O si visualizza messaggio di errore manca la data e si evidenzia la cella dove inseire la data.

Nella cella dove ho scritto resta il valore, è possibile cancellare questo valore dopo l'avviso di errore?

Private Sub Worksheet_Change(ByVal Target As Range)
'nei fogli
'obbligo dati cella precedente
  
  Dim avviso As String, sSh As String
   

 'If Intersect(Target, Worksheets("convalida").Range("B7:AO66")) Is Nothing Then Exit Sub 'nei fogli
 If Intersect(Target, ActiveSheet.Range("B7:O20")) Is Nothing Then Exit Sub 'nei fogli
 
 
  'If Target.Cells.Count > 1 Then Exit Sub
     
   If Not IsDate(Cells(Target.Row, 2)) Then
    'If Cells(Target.Row, 2) = "" Then
      
      avviso = MsgBox("Manca la data o formato data" & Chr(13) & _
      "errato nella cella < " & _
        Cells(Target.Row, 2).Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!")
            
        
      Application.EnableEvents = False
      Cells(Target.Row, 2).ClearContents
      Cells(Target.Row, 2).Select
      Application.EnableEvents = True
      
        
    End If
     
End Sub

 

[scossaPartecipante scossa Karma: 37 pts]

frank_ciccio ha scritto:

Nella cella dove ho scritto resta il valore, è possibile cancellare questo valore

Ma hai provato a studiare il codice? Guarda bene, ragionaci su e rispondi a queste due domande:

- cosa rappresenta Target? 

- qual è la cella dove hai scritto ?

 

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao,

purtroppo di vba ne so poco.

Le macro che ho o le ho fatte con il registratore o le ho trovate in rete o nei vari forum di excel.

 

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Questa è un'altra macro per data obbligatoria.

E' nel modulo del foglio2, l'altra del post#46933 è nel modulo del foglio3.

E' possibile modificare questa macro perchè faccia questo:

ora se scrivo in una cella della riga 14 si sposta in B14, e va bene.

Però la cella precedente non nuota è B11 quindi se la riga 14 è vuota il cursore deve spostarsi in B12 la prima non vuota della colonna B

 

Option Explicit


Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'------------------------------------------------------------------------------
'Data obbligatoria_new

Dim cella As Range
Dim avviso As String

If Intersect(Target, ActiveSheet.Range("B7:O20")) Is Nothing Then Exit Sub

Application.EnableEvents = False

Set cella = Cells(Target.Row, 2)

With cella
If .Value = "" Then
'MsgBox "Devi inserire una data nella cella " & cella.Address

  avviso = MsgBox("Manca la data o formato data" & Chr(13) & _
      "errato nella cella < " & _
        Cells(Target.Row, 2).Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!")
      
.Select
End If
End With

Application.EnableEvents = True

'------------------------------------------------------------------------------

End Sub

 

Allegati:

You must be logged in to view attached files.

[gianfranco55Partecipante gianfranco55 Karma: 91 pts]

ciao

al posto di

.Select

metti

Range("B7").End(xlDown).Offset(1, 0).Select

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie gianfranco55

[scossaPartecipante scossa Karma: 37 pts]

Ciao,

potresti risolvere aggiungedo un controllo nell'evento SelectionChange in modo che se selezioni una cella del range C7:O20 e la relativa riga è sotto all'ultima riga che contiene una data in colonna B allora si posiziona sulla cella B.

Questo il codice da inserire nel modulo ThisWorkbook (elimina gli altri codici dai moduli dei singoli fogli).

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rLR As Range
  
  If Sh.CodeName <> "Foglio1" Then 'esclude dal controllo il Foglio1
    Set rng = Sh.Range("B7:B20")
    Set rLR = rng.Find(what:="*", _
                     After:=rng.Cells(1), _
                     LookAt:=xlPart, _
                     LookIn:=xlFormulas, _
                     SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious, _
                     MatchCase:=False)
  
    If rLR Is Nothing Then Set rLR = Sh.Range("B6")
    If Not rLR Is Nothing And Not Intersect(Target, Sh.Range("C7:O20")) Is Nothing Then
      If rLR.Row < Target.Row Then
        Application.EnableEvents = False
        rLR.Offset(1).Select
        Application.EnableEvents = True
        MsgBox "Manca la data o formato data errato" & vbCrLf & _
        "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
      End If
    End If
  End If
End Sub

Allegato il file

Allegati:

You must be logged in to view attached files.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Grazie scossa la nuova macro è ok.

Una modifica: nella macro post#46993 se nelle celle colonna B (colonna della data) inserivo un valore diverso da una data si visualizzava  "errore data o formato data errato".

Nella nuova macro se formato errato non si visualizza l'errore

[scossaPartecipante scossa Karma: 37 pts]

Sostituisci tutta la routine con questa:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rLR As Range, bDate As Boolean, bDtValid As Boolean
  
  If Sh.CodeName <> "Foglio1" Then 'esclude dal controllo il Foglio1
    Set rng = Sh.Range("B7:B20")
    Set rLR = rng.Find(what:="*", _
                     After:=rng.Cells(1), _
                     LookAt:=xlPart, _
                     LookIn:=xlFormulas, _
                     SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious, _
                     MatchCase:=False)
  
    If rLR Is Nothing Then Set rLR = Sh.Range("B6")
    If Not rLR Is Nothing And Not Intersect(Target, Sh.Range("B7:O20")) Is Nothing Then
      If rLR.Row < Target.Row Then
        Application.EnableEvents = False
        rLR.Offset(1).Select
        Application.EnableEvents = True
        MsgBox "Manca la data " & vbCrLf & _
        "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
      Else
        If Not Intersect(Target, Sh.Range("B7:B20")) Is Nothing Then
          bDate = IsDate(ActiveCell.Value)
          If bDate Then bDtValid = CDate(ActiveCell.Value) >= CDate("01/01/2000")
          If Not bDate Or Not bDtValid Then
            Application.EnableEvents = False
              ActiveCell.ClearContents
            Application.EnableEvents = True
            MsgBox "data non valida " & vbCrLf & _
            "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
          End If
        End If
      End If
    End If
  End If
End Sub

N.B.: ricordati di cancellare dai moduli dei singoli fogli tutti i codici di evento (nel file che avevo allegato avevo lasciato quello nel Folio3).

Riallego il file corretto.

Allegati:

You must be logged in to view attached files.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

E' quasi perfetto.

Scrivo un valore diverso da una data esempio kkkkk in B12 nessun avviso clicco in B12 compare avviso data non valida in cella $b$12.

L'avviso dovrebbe comparire subito dopo aver scritto il valore errato ma non se funziona con

Private Sub Workbook_SheetSelectionChange

[scossaPartecipante scossa Karma: 37 pts]

frank_ciccio ha scritto:

Scrivo un valore diverso da una data esempio kkkkk in B12 nessun avviso

Nel file che ho allegato a me funziona: se scrivo adasd in B12 mi da l'avviso e cancella il contenuto.

Sicuro di aver cancellato gli eventi dai singoli fogli?

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

A me non funziona, il file è il tuo e non ho aggiunto niente.

[scossaPartecipante scossa Karma: 37 pts]

Non so cosa dirti:

prova a dire tutti i passaggi che fai, dall'apertura del file, per replicare il problema.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Scrivo in B12 dddd > invio nella cella resta dddd

clicco in B12 compare avviso errore

[scossaPartecipante scossa Karma: 37 pts]

frank_ciccio ha scritto:

Scrivo in B12 dddd > invio nella cella resta dddd

A me, come hai visto dalla gif sopra non succede, comunque ho rivisto un po' il codice, sostituiscilo a quello che hai:

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rLR As Range, bDate As Boolean, bDtValid As Boolean

  If Sh.CodeName <> "Foglio1" Then 'esclude dal controllo il Foglio1
    Set rng = Sh.Range("B7:B20")
    Set rLR = rng.Find(what:="*", _
                     After:=rng.Cells(1), _
                     LookAt:=xlPart, _
                     LookIn:=xlFormulas, _
                     SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious, _
                     MatchCase:=False)
  
    If rLR Is Nothing Then Set rLR = Sh.Range("B6")
    If Not rLR Is Nothing And Not Intersect(Target, Sh.Range("B7:O20")) Is Nothing Then
      If rLR.Row + IIf(ActiveCell.Column = 2, 1, 0) < Target.Row Then
        Application.EnableEvents = False
        rLR.Offset(1).Select
        Application.EnableEvents = True
        MsgBox "Manca la data " & vbCrLf & _
        "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
      Else
        If Not Intersect(Target, Sh.Range("B7:B20")) Is Nothing Then
            bDate = IsDate(ActiveCell.Value)
            If bDate Then bDtValid = CDate(ActiveCell.Value) >= CDate("01/01/2000")
            If Not bDate Or Not bDtValid Then
              If ActiveCell <> "" Then MsgBox "data non valida " & vbCrLf & _
              "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
              Application.EnableEvents = False
                ActiveCell.ClearContents
              Application.EnableEvents = True
            End If
         
        End If
      End If
    End If
  End If
End Sub

 

[LucaSRPartecipante LucaSR Karma: 15 pts]

Ciao sei sicuro di aver messo la X nel messaggio di errore e non il ? o il !  ?? Guarda bene il video di Scossa, ogni avviso di errore ha un comportamento diverso.

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

A me, come hai visto dalla gif sopra non succede

Vero ma accade perche' ti sposti con un colpo di mouse in una cella che gia' contiene un valore valido.

Frank_ciccio osserva invece che se scrivo una data non valida, per esempio una stringa di testo, in una cella e premo invio, la selezione attiva si sposta e viene intercettato questo cambiamento, ma non il fatto che ho inserito un valore non valido nella cella. Per questo caso secondo me serve implementare il codice per il relativo evento SheetChange (dal momento che siamo in ThisWorkbook).

Proposta di integrazione:

Private Sub Workbook_SheetChange(ByVal Sh As Object, ByVal Target As Range)
Dim bDate As Boolean
Dim bDtValid As Boolean

    Application.EnableEvents = False
        If Not Intersect(Target, Sh.Range("B7:B20")) Is Nothing Then
           bDate = IsDate(Target.Value)
           If bDate Then bDtValid = CDate(Target.Value) >= CDate("01/01/2000")
           If Not bDate Or Not bDtValid Then
            Target.Select
                If Trim(Target) <> "" Then MsgBox "data non valida " & vbCrLf & _
                    "nella cella < " & Target.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
               ActiveCell.ClearContents
            End If
        End If
    Application.EnableEvents = True
End Sub

Con l'inconveniente che se inserisco una data non valida prima mi viene segnalato l'errore, poi il dato viene cancellato dalla macro di selezione, poi parte l'avviso che manca la data. Insomma una sequenza di beep fastidiosi 🙂

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Ciao a tutti.

Anche la nuova macro di scossa continua a non funzionare da me.

La macro di vecchio frac funziona in parte. Manca la parte che se scrivo in una riga/cella vuota, e in questa riga manca la data nella cella B, si visualizza l'errore e si sposta nella cella B

[alexps81Moderatore alexps81 Karma: 58 pts]

Non mi è molto chiaro il controllo sulla data "01/01/2000"...forse si sta verificando se la data inserita non sia inferiore al "01/01/2000"?

Se fosse così, io proporrei questo (da inserire in "ThisWorkbook" o "Questa_cartella_di_lavoro"):

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
Dim rng As Range, c As Range, ur As Range

If Sh.CodeName = "Foglio1" Then Exit Sub

Set rng = Sh.Range("B7:B20")

Set rng = Sh.Range("B7:B20")
Set ur = rng.Find(What:="*", _
            After:=rng.Cells(1), _
            LookAt:=xlPart, _
            LookIn:=xlFormulas, _
            SearchOrder:=xlByRows, _
            SearchDirection:=xlPrevious, _
            MatchCase:=False)

If ur Is Nothing Then Set ur = Sh.Range("B7")

For Each c In Sh.Range("B7:" & ur.Address)
    If IsDate(c.Value) Then
        If CDate(c.Value) < DateSerial(2000, 1, 1) Then
            MsgBox "Attenzione...la data non può essere inferiore al ""01/01/2000""", vbCritical, "Attenzione..."
            Application.EnableEvents = False
            c.ClearContents
            c.Select
            Application.EnableEvents = True
            Exit Sub
        End If
    ElseIf Not IsEmpty(c.Value) Then
        MsgBox "Attenzione...il valore inserito non è una data.", vbCritical, "Attenzione..."
        Application.EnableEvents = False
        c.ClearContents
        c.Select
        Application.EnableEvents = True
        Exit Sub
    End If
Next c

If Not Intersect(Target, Sh.Range("B" & ur.Row + 1 & ":O20")) Is Nothing Then
    If Not IsEmpty(Sh.Range("B7")) Then
        If Intersect(Target, Sh.Range("B" & ur.Row + 1)) Is Nothing Then
            MsgBox "Attenzione...per ora puoi selezionare solo la cella < " & ur.Row + 1 & " >", vbCritical, "Attenzione..."
            Application.EnableEvents = False
            Sh.Cells(ur.Row + 1, "B").Select
            Application.EnableEvents = True
        End If
    Else
        MsgBox "Attenzione...per ora puoi selezionare solo la cella < " & ur.Row & " >", vbCritical, "Attenzione..."
        Application.EnableEvents = False
        Sh.Cells(ur.Row, "B").Select
        Application.EnableEvents = True
    End If
End If

Set rng = Nothing
Set ur = Nothing

End Sub

 

[scossaPartecipante scossa Karma: 37 pts]

Hai ragione riguardo lo spostamento di cella mediante tasti freccia o Invio (se nelle impostazioni lo spostamento di cella è attivato, io lo tengo disattivato quindi non cambia celle).

Ho corretto il codice, che riporto sotto.

Rigurado a

vecchio frac ha scritto:

Per questo caso secondo me serve implementare il codice per il relativo evento SheetChange (dal momento che siamo in ThisWorkbook).

invece no: l'evento SelectionChange (a dispetto di come è scritto il nome) viene scatenato sia in caso di Selection sia di Change; la cosa è immediatamente verificabile se disattivate lo spostamento del cursore dopo Invio (impostando application.MoveAfterReturn = False) e provate questo codice in un foglio:

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  MsgBox Target.Address
End Sub

vedrete che il messaggio appare anche scrivendo qualcosa nella cella attiva (quindi senza averla selezionata).

Questo il codice corretto da sostituire al precedente (eliminando eventuali codici di evento Change negli vari moduli):

Private Sub Workbook_SheetSelectionChange(ByVal Sh As Object, ByVal Target As Range)
  Dim rng As Range, rLR As Range, bDate As Boolean, bDtValid As Boolean

  If Sh.CodeName <> "Foglio1" Then 'esclude dal controllo il Foglio1
    Set rng = Sh.Range("B7:B20")
    Set rLR = rng.Find(what:="*", _
                     After:=rng.Cells(1), _
                     LookAt:=xlPart, _
                     LookIn:=xlFormulas, _
                     SearchOrder:=xlByRows, _
                     SearchDirection:=xlPrevious, _
                     MatchCase:=False)
  
    If rLR Is Nothing Then Set rLR = Sh.Range("B6")
    If Not rLR Is Nothing And Not Intersect(Target, Sh.Range("B7:O20")) Is Nothing Then
      If rLR.Row < Target.Row And Not IsDate(rLR) Then
        Application.EnableEvents = False
        ActiveCell.ClearContents
        rLR.ClearContents
        rLR.Select
        Application.EnableEvents = True
        MsgBox "data mancante o non valida " & vbCrLf & _
        "nella cella < " & ActiveCell.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
      Else
        If Not Intersect(Target, Sh.Range("B7:O20")) Is Nothing Then
            bDate = IsDate(Sh.Range("B" & rLR.Row).Value)
            If bDate Then bDtValid = CDate(Sh.Range("B" & rLR.Row).Value) >= CDate("01/01/2000")
            If Not bDate Or Not bDtValid Then
              If rLR.Value <> "" Then MsgBox "data non valida " & vbCrLf & _
              "nella cella < " & rLR.Address & " > !", vbCritical + vbOKOnly + vbDefaultButton2, "ERRORE!"
              Application.EnableEvents = False
                rLR.ClearContents
                rLR.Select
              Application.EnableEvents = True
            End If
         
        End If
      End If
    End If
  End If
End Sub

Allegati:

You must be logged in to view attached files.

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

La macro di alexps81 mi sembra esatta per tutto.

La nuova macro di scossa funziona in parte. Manca la parte che se scrivo in una riga/cella vuota, e in questa riga manca la data nella cella B, si visualizza l'errore e si sposta nella cella B

La macro di vecchio frac funziona in parte. Manca la parte che se scrivo in una riga/cella vuota, e in questa riga manca la data nella cella B, si visualizza l'errore e si sposta nella cella B

[scossaPartecipante scossa Karma: 37 pts]

frank_ciccio ha scritto:

La nuova macro di scossa funziona in parte. Manca la parte che se scrivo in una riga/cella vuota, e in questa riga manca la data nella cella B, si visualizza l'errore e si sposta nella cella B

Hai ragione, ho avuto fretta di correggere per rispondere e non ho verificato bene, scusa.

Appena avrò un po' di tempo vedrò di sistemarla.

La proposta di Alex è ottima (anche se non mi piace l'uso del ciclo For)   

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

invece no: l'evento SelectionChange (a dispetto di come è scritto il nome) viene scatenato sia in caso di Selection sia di Change; la cosa è immediatamente verificabile se disattivate lo spostamento del cursore dopo Invio

Si' ma e' un effetto collaterale perche' la conferma di un dato con Invio produce comunque lo spostamento della cella --si rimane sulla stessa cella perche' abbiamo disattivato lo spostamento, e' vero, ma internamente i due eventi sono distinti. Anche se producono all'atto pratico il medesimo effetto (in questo caso).

[vecchio fracSenior Moderator vecchio frac Karma: 272 pts]

scossa ha scritto:

La proposta di Alex è ottima

Alex, conservati questo post perche' gli apprezzamenti di scossa arrivano col contagocce e solo quando sono meritati (infatti a me non arrivano mai   )

[frank_ciccioPartecipante frank_ciccio Karma: 3 pts]

Alexps81 la tua macro funziona.

Ho fatto una modifica per aumentare il range a Set rng = Sh.Range("B7:P5000") e non funziona esatto.

Probabilmente c'è dell'altro da modificare.

Allegati:

You must be logged in to view attached files.

[Autore]

Articoli