Solitamente non disturberei il forum per una quisquiglia di questo tipo. Ma sono 2 giorni che sbatto su questo problema e non ne vengo a capo perciò chiedo aiuto per capire se il mio è un errore di di procedura o concettuale.
Ho una maschera principale con al suo interno 12 maschere di visualizzazione non collegate alla principale. Queste maschere sono alimentate da query autonome i cui parametri vengono letti da una form nascosta adibita ai conteggi.
Per farla breve. Nell'intestazione di ogni sottomaschera ho due label che mi consentono di aggiungere dati (aprendo una maschera pop up di inserimento) e un pulsante per cancellare TUTTO il contenuto della maschera stessa.
Private Sub LblAddDec_Click()
Dim NumeroDec, Nslot As Integer
Dim StrSQL, Aereo As String
Dim Ctl As Control
Dim Dec As Long
If Not GetDebug() Then On Error GoTo Errore
If DCount("*", Me.RecordSource) = 0 Then
Select Case GetNplane()
Case 1
If GetDecMax() = 0 Then
NumeroDec = 1
Else
NumeroDec = GetDecMax() + 1
End If
Forms!Frm_hidden2!txtselplane = GetPlane1()
Case 2
DoCmd.OpenForm "Frm_selplane", , , , , acDialog
Select Case Forms!Frm_hidden2!txtselplane
Case GetPlane1()
If GetDecMax() = 0 Then
NumeroDec = 1
Else
NumeroDec = GetDecMax() + 1
End If
Case GetPlane2()
If GetDecMax2() = 0 Then
NumeroDec = 1
Else
NumeroDec = GetDecMax2() + 1
End If
End Select
End Select
Aereo = DLookup("Marca_aereomobile", "Aereomobili", "ID_aereomobile=" & Val(Forms!Frm_hidden2!txtselplane))
Nslot = DLookup("N_slot", "Aereomobili", "ID_aereomobile=" & Val(Forms!Frm_hidden2!txtselplane))
StrSQL = "INSERT INTO Decolli(Data_decollo,Numero_decollo,Aereomobile,N_slot,Cod_aereomobile,Cod_dropzone) VALUES (""" & Date & """,""" & NumeroDec & """,""" & Aereo & """,""" & Nslot & """,""" & Val(Forms!Frm_hidden2!txtselplane) & """,""" & GetIdDrop() & """)"
CurrentDb.Execute StrSQL
Dec = DBEngine(0)(0).OpenRecordset("SELECT @@identity FROM Decolli")(0)
Else
Forms!Frm_hidden2!txtselplane = GetPlane1()
Dec = Me.ID_decollo
End If
Call DimSubForm(1, 1, Me.Form, GetSlot1())
Call AggiornaLoad(GetNplane(), "T", Dec)
Forms!Frm_hidden2!txtselplane = ""
Errore:
If Not GetDebug() Then
If Err.Number <> 0 Then
Call GError(Str(Err.Number), Err.Description)
Resume Next
End If
End If
End Sub
Così facendo viene scatenato l'evento OnCurrent
Private Sub Form_Current()
Dim Q As Integer
If Not GetDebug() Then On Error GoTo Errore
If DCount("*", Me.RecordSource) = 0 Then
Q = 0
Me.Numero_decollo.Visible = False
Me.ImgDec.Visible = False
Me.ImgDel.Visible = False
Me.LblAddDec.Visible = True
Else
Q = DCount("*", "Scambio_decolli", "Cod_decollo=" & Me.ID_decollo)
Me.Numero_decollo.Visible = True
Me.ImgDec.Visible = True
Me.ImgDel.Visible = True
Me.LblAddDec.Visible = False
Select Case Q
Case Is < GetSlotDec(Me.ID_decollo)
Me.LblAddPass.Visible = True
Case Else
Me.LblAddPass.Visible = False
End Select
End If
Me.CmdSelect.SetFocus
Errore:
If Not GetDebug() Then
If Err.Number <> 0 Then
Call GError(Str(Err.Number), Err.Description)
Resume Next
End If
End If
End Sub
E fin qui tutto bene…. La maschera si aggiorna e presenta i dati.
Il problema si presenta nel caso io vado a cancellare il contenuto.
Private Sub ImgDel_Click()
Dim StrFind, StrMsg, StrTtl, StrSQL, StrFinder As String
Dim RetValue As Variant
Dim N_del, N_max, Q As Integer
Dim DbCorrente As DAO.Database
Dim RsCorrente As DAO.Recordset
Dim Id_del, Id_aereo, Id_Max As Long
Dim Riordina As Boolean
Dim DataDecollo As Date
If Not GetDebug() Then On Error GoTo Errore
DataDecollo = Date
Id_del = 0
If DCount("*", Me.RecordSource) = 0 Then GoTo Fuori
Set DbCorrente = CurrentDb
Id_aereo = Me.Cod_aereomobile
Riordina = False
StrMsg = "Vuoi eliminare il decollo " & Me.Numero_decollo & "?"
StrTtl = "ATTENZIONE"
RetValue = MsgBox(StrMsg, vbQuestion + vbYesNo, StrTtl)
Select Case RetValue
Case vbNo
Exit Sub
Case vbYes
Id_del = Me.ID_decollo
N_del = Val(Me.Numero_decollo)
N_max = DCount("*", "Decolli", "DAta_decollo=#" & Format(Date, "MM/dd/YYYY") & "# AND cod_aereomobile=" & Id_aereo & " AND cod_dropzone=" & GetIdDrop())
If N_max = 0 Then
RetValue = MsgBox("NON CI SONO DECOLLI CARICATI", vbCritical, "ATTENZIONE")
Exit Sub
End If
If N_del < N_max Then
StrMsg = "Stai eliminando un decollo intermedio"
StrMsg = StrMsg & vbCrLf & vbCrLf
StrMsg = StrMsg & "Vuoi scalare i decolli successivi?"
Else
GoTo EraseDec
End If
RetValue = MsgBox(StrMsg, vbQuestion + vbYesNo, StrTtl)
Select Case RetValue
Case vbYes
Riordina = True
Case vbNo
GoTo ErasePar
End Select
End Select
EraseDec:
Set RsCorrente = DbCorrente.OpenRecordset("Decolli", dbOpenDynaset)
StrFind = "Id_decollo=" & Me.ID_decollo
RsCorrente.FindFirst (StrFind)
If Not RsCorrente.NoMatch Then RsCorrente.Delete
If Riordina Then
StrFind = "Data_decollo=#" & Format(Date, "MM/dd/YYYY") & "# and cod_aereomobile=" & Id_aereo & " AND cod_dropzone=" & GetIdDrop()
RsCorrente.FindFirst (StrFind)
If Not RsCorrente.NoMatch Then
While Not RsCorrente.NoMatch
If RsCorrente.Fields(2) > N_del Then
RsCorrente.Edit
RsCorrente.Fields(2) = RsCorrente.Fields(2) - 1
RsCorrente.Update
End If
RsCorrente.FindNext (StrFind)
Wend
End If
End If
GoTo Closing
ErasePar:
Set RsCorrente = DbCorrente.OpenRecordset("Scambio_decolli", dbOpenDynaset)
StrFind = "Cod_decollo=" & Val(Me.ID_decollo)
RsCorrente.FindFirst (StrFind)
While Not RsCorrente.NoMatch
RsCorrente.Delete
RsCorrente.FindNext (StrFind)
Wend
Closing:
Set RsCorrente = DbCorrente.OpenRecordset("Decolli", dbOpenDynaset)
RsCorrente.FindFirst ("Data_decollo=#" & Format(Date, "MM/dd/YYYY") & "# AND cod_aereomobile=" & Id_aereo & " And cod_dropzone=" & GetIdDrop())
If Not RsCorrente.NoMatch Then Call Changeback(RsCorrente.Fields(0))
Call AggiornaLoad(GetNplane(), "T", Id_del)
StrSQL = "Update dati_drop set Alert_ConteggiIP=0"
CurrentDb.Execute StrSQL
StrSQL = "Update dati_drop set Alert_ConteggiPara=0"
CurrentDb.Execute StrSQL
StrSQL = "Update dati_drop set Alert_AFF=0"
CurrentDb.Execute StrSQL
StrSQL = "Update dati_drop set Alert_TDM=0"
CurrentDb.Execute StrSQL
Set RsCorrente = Nothing
Set DbCorrente = Nothing
Fuori:
Me.Requery
Forms!Frm_hidden2!txtselplane = ""
Errore:
If Not GetDebug() Then
If Err.Number <> 0 Then
Call GError(Str(Err.Number), Err.Description)
Resume Next
End If
End If
End Sub
La Sottomaschera dovrebbe riportarsi allo stato iniziale con la label LblAddDec visible e il resto no, ma invece non esegue questa procedura e visualizza solamente una maschera vuota con i comandi ancora visibili (Mentre dovrebbero esser nascosti).
Ora so che il requery è una operazione asincrona. Sono a conoscenza che le subform hanno limitazioni per gli eventi. Mi chiedevo se c'è un modo effettivo per passare all'evento OnCurrent delle mie subform dopo la pressione del pulsante Img_del della mia subform.
Qualche suggerimento?