Requery sottomaschere non collegate (Richiamare evento OnCurrent)

di il
1 risposte

Requery sottomaschere non collegate (Richiamare evento OnCurrent)

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?

1 Risposte

  • Re: Requery sottomaschere non collegate (Richiamare evento OnCurrent)

    Intanto che aspettavo un consiglio ho risolto la mia necessità applicando queste due modifiche.

    Private Sub ImgDel_Click()
    Dim StrFind, StrMsg, StrTtl, StrSQL 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
    Dim Frm As Form
    Dim Ctl As Control
    
      If Not GetDebug() Then On Error GoTo Errore
      DataDecollo = Date
      Id_del = 0
      StrTtl = "ATTENZIONE"
      Select Case DCount("*", Me.RecordSource)
        Case 0
          GoTo Fuori
        Case Else
          Id_aereo = Me.Cod_aereomobile
          Riordina = False
          StrMsg = "Vuoi eliminare il decollo " & Me.Numero_decollo & "?"
          RetValue = MsgBox(StrMsg, vbQuestion + vbYesNo, StrTtl)
          Select Case RetValue
            Case vbNo
              GoTo Fuori
            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")
                GoTo Fuori
              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 DbCorrente = CurrentDb
          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 DbCorrente = CurrentDb
          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))
          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
          Call AggiornaLoad(GetNplane(), "T", Id_del)
      End Select
    Fuori:
      Select Case True
        Case Aperta("Frm_lavagna")
          Set Frm = Forms!Frm_lavagna
          For Each Ctl In Frm
            If Ctl.ControlType = acSubform And Ctl.Tag Like "ELENCO*" Then
              Call ResetSForm(Ctl.Form)
            End If
          Next Ctl
        Case Aperta("Frm_lavagna2")
          Set Frm = Forms!Frm_lavagna2
          For Each Ctl In Frm
            If Ctl.ControlType = acSubform And Ctl.Tag Like "ELENCO*" Then
              Call ResetSForm(Ctl.Form)
            End If
          Next Ctl
      End Select
    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 questa è la public sub ResetSform

    Public Sub ResetSForm(ByVal Sform As Form)
    Dim Q As Integer
    
      If DCount("*", Sform.RecordSource) = 0 Then
        Sform!Numero_decollo.Visible = False
        Sform!ImgDec.Visible = False
        Sform!ImgDel.Visible = False
        Sform!LblAddDec.Visible = True
        Sform!LblAddPass.Visible = False
      Else
        Q = DCount("*", "Scambio_decolli", "Cod_decollo=" & Sform!ID_decollo)
        Sform!Numero_decollo.Visible = True
        Sform!ImgDec.Visible = True
        Sform!ImgDel.Visible = True
        Sform!LblAddDec.Visible = False
        Select Case Q
          Case Is < GetSlotDec(Sform!ID_decollo)
            Sform!LblAddPass.Visible = True
          Case Else
            Sform!LblAddPass.Visible = False
        End Select
      End If
    End Sub
    

    In attesa di valutazioni tecniche dai più esperti continuo a cercare COME attivare l'evento OnCurrent. Perchè questa macchinosa procedura di andare ad agire sui controlli SubForm per SubForm sarebbe molto più semplice e pulita se con il classico requery le varie subform eseguissero l'evento OnCurrent.

Devi accedere o registrarti per scrivere nel forum
1 risposte