IALweb Homepage
Forum Home Forum Home > MS Office > Microsoft Office > Microsoft Excel
  New Posts New Posts RSS Feed - [RISOLTO] Warning su celle vuote
  FAQ FAQ  Forum Search   Events   Register Register  Login Login


REGISTRATEVI su IALWeb forum!

[RISOLTO] Warning su celle vuote

 Post Reply Post Reply
Author
Message
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Topic: [RISOLTO] Warning su celle vuote
    Posted: 09/Ott/2018 at 13:16
Ciao a Tutti,

ho il seguente file di Excel: uploads/19358/ini9_prova_warning_tre.rar

sul quale devo fare il seguente controllo:
se l' utente omette di scrivere un valore,
all' interno del range che va dalla colonna B al range in cui compare la colonna C_format,
allora scatta il Warning di compilare tutti i campi, all' atto della chiusura.

Nel codice VBA allegato, in questi gg ho provato a fare 3.000 controlli ed ora mi sono esaurito, come la pila ...

Il concetto che ho impostato è il seguente:
definisco una variabile globale,
durante lo Sheet_Change devo calcolare la riga massima in cui è avvenuta l' ultima modifica,
passo questa informazione al Before_Close in cui scatta il Warning se i campi di quella riga non sono stati tutti compilati.

Grazie mille in anticipo come sempre !!!

password per sbloccare: pippo



Edited by il_betto - 10/Ott/2018 at 10:59
Back to Top
Sponsored Links


Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 16:40
Il problema rispetto a prima si è un po' ridotto:

Ora il Warning parte regolarmente:

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   Dim xBarControl As CommandBarControl
   Dim FileName
   Dim FileTmp As String
   Dim domanda, i As Integer
   Dim w_out() As String, msgA As String
   Dim ii As Long, zr As Long, zc As Long


   For Each xBarControl In Application.CommandBars.FindControls(ID:=293)
            xBarControl.Enabled = True
   Next
   For Each xBarControl In Application.CommandBars.FindControls(ID:=294)
            xBarControl.Enabled = True
   Next
   

   Application.DisplayAlerts = False
     
   If UCase(Environ$("username")) = "AG10048" Or UCase(Environ$("username")) = "AG26325" Or UCase(Environ$("username")) = "AG66332" Then
      '
      If Changed Then
         
         LRm = ActiveSheet.Cells.SpecialCells(xlCellTypeLastCell).Row
         For zc = 2 To ActiveSheet.Range(C_format & "1").Column
             If (IsEmpty(ActiveSheet.Cells(LRm, zc).Value) Or IsNull(ActiveSheet.Cells(LRm, zc).Value)) Then
                MsgBox LRm & " Riempire tutte le celle dalla colonna Type a Format," & vbCrLf & "per salvare correttamente il file !!", vbCritical, "Avviso !"
                Exit For
             End If
         Next zc
         
      End If
      '
   Else
       MsgBox "Salvare il file è un' operazione non permessa !!"
       Application.Quit
   End If

End Sub

solo che se ad esempio modifico la riga 17 che ha alcuni campi bianchi,
scatta giustamente il Warning
cancello tutto il contenuto nella riga 17 nel range che va da colonna B a colonna dove c' e' intestazione "Format"
modifico riga 13
mi scatta ancora Warning su riga 17 che ormai non ha più alcun valore .. .come mai ?? Ouch


ho provato a far ricalcolare l' ultima riga nello Sheet_change
ma lui tiene in memoria sempre la riga 17 (in questo caso)

Ho chiuso il file e forzato il valore della variabile LRm a 1 per vedere di togliere il Warning,
ma anche se chiudo ed apro il file lui mantiene in memoria la 17...
Ouch

Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 18:25
Mettendo il codice così funziona meglio, però fa il controllo solo sull' ultima riga aggiunta.

uploads/19358/ini9_prova_warning_tre_tris.rar

Se cancello un campo all' interno del range B2 C_format column, la cella vuota all' interno del range non viene segnalata

Private Sub Workbook_SheetChange(ByVal sh As Object, ByVal Target As Range)
   
   Dim C_date, C_K, C_L, C_type
   Dim r As Long, jj As Long, zz As Long
   
   Changed = True
   w_list = ""
   Call Largest
   max_rev_fin = max_rev
   
   On Error GoTo errore
   
   Application.EnableEvents = False

   C_date = Application.Match("Creation date", Sheets(ActiveSheet.Name).Rows(1), 0)
   C_type = Application.Match("Sub Type", Sheets(ActiveSheet.Name).Rows(1), 0)
   If ActiveSheet.Cells(Target.Row, C_type) <> "" And IsEmpty(ActiveSheet.Cells(Target.Row, C_date)) = True Then
      r = Target.Row
      If r > 1 Then ActiveSheet.Cells(r, C_date) = Format(Date, "dd-mmm-yyyy")
   End If
   

   If Not Intersect(Target, Range("B2:" & C_format & ur)) Is Nothing Then
      '
      For jj = 2 To ActiveSheet.Range(C_format & "1").Column
          w_list = w_list & Chr(64 + ActiveSheet.Cells(jj).Column)
      Next jj
      '
      If InStr(w_in, Chr(64 + Target.Column)) = 0 Then w_in = Chr(64 + Target.Column) & ";" & w_in
      ' MsgBox "valore IN range " & Chr(64 + Target.Column)
      '
      LRm = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
      MsgBox LRm
           '
      Cells(Target.Row, "A").Value = Cells(Target.Row, "A").Value + 1
      If Not C_notice Is Nothing Then
           C_K = Split(C_notice.Address, "$")(1)
           Cells(Target.Row, C_K).Value = max_rev_ori + 1
      End If
      If Not C_search Is Nothing Then
           C_L = Split(C_search.Address, "$")(1)
           If Cells(Target.Row, "A").Value < 2 Then Cells(Target.Row, C_L).Value = Cells(Target.Row, C_L).Value + 1
      End If
      '
      Call Largest
      '
   End If

   Application.EnableEvents = True
   

   

xit:
Application.EnableEvents = True
Exit Sub
errore:
MsgBox Err.Number & " - " & Err.Description
Resume xit
End Sub

Private Sub Workbook_SheetBeforeDelete(ByVal sh As Object)
Stop
End Sub

Private Sub Workbook_BeforeClose(Cancel As Boolean)

   Dim xBarControl As CommandBarControl
   Dim FileName
   Dim FileTmp As String
   Dim domanda, i As Integer
   Dim w_out() As String, msgA As String
   Dim ii As Long, zr As Long, zc As Long


   For Each xBarControl In Application.CommandBars.FindControls(ID:=293)
            xBarControl.Enabled = True
   Next
   For Each xBarControl In Application.CommandBars.FindControls(ID:=294)
            xBarControl.Enabled = True
   Next
   

   Application.DisplayAlerts = False
     
   If UCase(Environ$("username")) = "AG10048" Or UCase(Environ$("username")) = "AG26325" Or UCase(Environ$("username")) = "AG66332" Then
      '
      If Changed Then
         
         LRm = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
         For zc = 2 To ActiveSheet.Range(C_format & "1").Column
             If IsEmpty(ActiveSheet.Cells(LRm, zc).Value) Then
                MsgBox LRm & " Riempire tutte le celle dalla colonna Type a Format," & vbCrLf & "per salvare correttamente il file !!", vbCritical, "Avviso !"
                Exit For
             End If
         Next zc
         
      End If
      '
   Else
       MsgBox "Salvare il file è un' operazione non permessa !!"
       Application.Quit
   End If

End Sub



Edited by il_betto - 09/Ott/2018 at 18:26
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11043
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 18:26
Ciao
ti ho già detto in un'altra occasione che usedrange oppure ...SpecialCells(xlCellTypeLastCell)...
non sono affidabili a meno che, prima di calcolarli non salvi il documento.
Questo in quanto excel, anche se cancelli un dato, con quelle istruzioni tiene in memoria
l'ultima riga modificata (anche se cancellata).

Pertanto o utilizzi:

lrm=range("A" & rows.count).end(xlup).row
(ma devi conoscere qual è la colonna che contiene più dati

oppure usi un work-around tipo:

lrm = Cells.Find("*", SearchOrder:=xlByRows, SearchDirection:=xlPrevious).Row

saluti
domenico
win 10- office 2016
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 18:28
Grazie dodo, ho visto e ho postato una soluzione che però non tiene conto dei casi in cui ci sono celle vuote all' interno del range ...
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 18:38
Ho provato a mettere:


   If Not Intersect(Target, Range("B2:" & C_format & ur)) Is Nothing Then
      '
      For jj = 2 To ActiveSheet.Range(C_format & "1").Column
          w_list = w_list & Chr(64 + ActiveSheet.Cells(jj).Column)
      Next jj
      '
      If InStr(w_in, Chr(64 + Target.Column)) = 0 Then w_in = Chr(64 + Target.Column) & ";" & w_in
      ' MsgBox "valore IN range " & Chr(64 + Target.Column)
      '
      For zz = 2 To ActiveSheet.Range(C_format & "1").Column
          If IsEmpty(ActiveSheet.Cells(Target.Row, zz).Value) Then
             MsgBox Target.Row & " Riempire tutte le celle dalla colonna Type a Format," & vbCrLf & "per salvare correttamente il file !!", vbCritical, "Avviso !"
             ' Exit For
          End If
      Next zz
           '
      Cells(Target.Row, "A").Value = Cells(Target.Row, "A").Value + 1
      If Not C_notice Is Nothing Then
           C_K = Split(C_notice.Address, "$")(1)
           Cells(Target.Row, C_K).Value = max_rev_ori + 1
      End If
      If Not C_search Is Nothing Then
           C_L = Split(C_search.Address, "$")(1)
           If Cells(Target.Row, "A").Value < 2 Then Cells(Target.Row, C_L).Value = Cells(Target.Row, C_L).Value + 1
      End If
      '
      Call Largest
      '
   End If

penso che sia sufficiente ... 
dovrei aver risolto !!
prima faccio tutti i check ....



Edited by il_betto - 09/Ott/2018 at 18:39
Back to Top
dodo47 View Drop Down
Moderatore
Moderatore
Avatar

Joined: 29/Dic/2008
Location: Italy
Status: Offline
Points: 11043
Post Options Post Options   Thanks (0) Thanks(0)   Quote dodo47 Quote  Post ReplyReply Direct Link To This Post Posted: 09/Ott/2018 at 19:01
Ciao
probabilmente non ho capito che vuoi.
SE devi controllare che tutte le celle da B2 a colonna c_format/utlima riga disponibile contengano un valore, non ti basta ciclare il range interessato??

Es:

Sub test()
Dim lrm As Long, rng As Range
lrm = ActiveSheet.Cells.Find("*", searchorder:=xlByRows, searchdirection:=xlPrevious).Row
'poniamo per esempio che la colonna c_format sia la col. I

For j = 2 To lrm
    For Each rng In Range("B" & j & ":I" & j)
        If rng.Value = "" Then
            MsgBox "Riempire....."
            Exit sub
        End If
    Next
Next

End Sub

saluti


Edited by dodo47 - 10/Ott/2018 at 09:34
domenico
win 10- office 2016
Back to Top
il_betto View Drop Down
Veterano
Veterano
Avatar

Joined: 13/Giu/2011
Status: Offline
Points: 3312
Post Options Post Options   Thanks (0) Thanks(0)   Quote il_betto Quote  Post ReplyReply Direct Link To This Post Posted: 10/Ott/2018 at 10:59
Ciao dodo, grande !!!!

La soluzione che mi hai prospettato è perfetta !!!

In Before_Close ho messo così come mi hai detto:

    For j = 2 To lrm
        For Each rng In Range("B" & j & ":" & C_format & j)
            If rng.Value = "" Then
               MsgBox "Riempire....." & rng.Address
               Exit Sub
            End If
        Next
    Next

funziona benissimo !!!

Grazieee !! Clap Clap

Back to Top
 Post Reply Post Reply
  Share Topic   

Forum Jump Forum Permissions View Drop Down

Forum Software by Web Wiz Forums® version 10.17
Copyright ©2001-2013 Web Wiz Ltd.

This page was generated in 0,047 seconds.