Categories: Database

Carico e Scarico Merci in un Programma Gestionale

Continuiamo la creazione del nostro programma per magazzino Calus 2012 vedendo come inserire delle finestre per la gestione del carico e scarico merci. Ecco come dobbiamo creare la nostra finestra, in particolare utilizzare il modello principale e dettaglio spiegato in un articolo di qualche tempo fa.

Finestra per la gestione del carico merci

Per costruire questo tipo di finestra abbiamo bisogno di un form principale che contiene un sotto-form per i dettagli. Oltre ai campi come numero e data del movimento, la finestra principale deve filtrare i dati, ecco il codice VBA:

Option Compare Database

Private Sub Anno_Change()
    If Not IsNull(Me.Anno.Text) Then
        If IsNumeric(Me.Anno.Text) And Me.Anno.Text <> "" Then
            Dim strDate As String

            strDate = "01/01/" & Me.Anno.Text
            If IsDate(strDate) Then
                Me.FilterOn = True
                Me.Filter = "Data BETWEEN #01/01/" & Me.Anno.Text
                         & "# AND #31/12/" & Me.Anno.Text & "#"

                Dim myData As dao.Database
                Dim myRec As dao.Recordset

                Set myData = CurrentDb
                Set myRec = myData.OpenRecordset("Scelte")
                With myRec
                    .Edit
                    !AnnoCar = CLng(Me.Anno.Text)
                    .Update
                    .Close
                End With
                Set myData = Nothing

                Exit Sub
            End If
        End If
    End If

End Sub

Private Sub Cognome_DblClick(Cancel As Integer)
    On Error GoTo Err_Fornitore_DblClick

    Dim lFor As Long

    lFor = 0
    If Not IsNull(Me!IDFornitore) Then
        lFor = Me!IDFornitore
        DoCmd.OpenForm "Fornitori", , , , , acDialog, Me!IDFornitore
    Else
        DoCmd.OpenForm "Fornitori", , , , , acDialog, "GoToNew"
    End If

    lFor = CLng(GetSetting("Calus", "RetVal", "Last", 0))
    DeleteSetting "Calus", "RetVal"
    If lFor <> 0 Then Me!IDFornitore = lFor
    Me.Cognome.Requery
    Me.Nome.Requery

Exit_Fornitore_DblClick:
    Exit Sub
Err_Fornitore_DblClick:
    MsgBox Err.Description
    Resume Exit_Fornitore_DblClick
End Sub

Private Sub Form_Unload(Cancel As Integer)

    Forms![Pannello comandi].Visible = True

End Sub

Private Sub Nome_DblClick(Cancel As Integer)
    Cognome_DblClick (Cancel)
End Sub

Private Sub Form_Load()
    Dim myData As dao.Database
    Dim myRec As dao.Recordset

    Set myData = CurrentDb
    Set myRec = myData.OpenRecordset("Scelte")
    Me.Anno = myRec!AnnoCar
    myRec.Close
    Set myData = Nothing

    If Not IsNull(Me.Anno) Then
        If IsNumeric(Me.Anno) And Me.Anno <> "" Then
            Dim strDate As String

            strDate = "01/01/" & Me.Anno
            If IsDate(strDate) Then
                Me.FilterOn = True
                Me.Filter = "Data BETWEEN #01/01/" & Me.Anno &
                    "# AND #31/12/" & Me.Anno & "#"
                DoCmd.GoToRecord acDataForm, "Carichi", acLast
                Exit Sub
            End If
        End If
    End If
    Me.Filter = ""
    Me.FilterOn = False
    DoCmd.GoToRecord acDataForm, "Carichi", acLast
End Sub

La maschera dei dettagli invece deve aggiornare l’imponibile e l’iva, ma anche la giacenza del materiale, ecco il codice per fare tutto questo:

Option Compare Database
Option Explicit

Private Sub Descrizione_Articolo_AfterUpdate()
    Matricola_Articolo_AfterUpdate
End Sub

Private Sub Descrizione_Articolo_DblClick(Cancel As Integer)
    Matricola_Articolo_DblClick (Cancel)
End Sub

Private Sub Descrizione_Articolo_NotInList(NewData As String,
   Response As Integer)
        Matricola_Articolo_NotInList NewData, Response
End Sub

Private Sub Codice_a_Barre_AfterUpdate()
    Matricola_Articolo_AfterUpdate
End Sub

Private Sub Codice_a_Barre_DblClick(Cancel As Integer)
    Matricola_Articolo_DblClick (Cancel)
End Sub

Private Sub Codice_a_Barre_NotInList(NewData As String,
   Response As Integer)
      Matricola_Articolo_NotInList NewData, Response
End Sub

Private Sub Iva_AfterUpdate()

    Dim vVal, vImposta, vTotale As Currency
    vVal = 0#
    vImposta = 0#
    vTotale = 0#
    If Not IsNull(Me!IDArticolo) Then
        vVal = Me.Prezzo
        If Not IsNull(Me.Quantità) And Me.Quantità <> "" Then
            vVal = vVal * CSng(Me.Quantità)
            vImposta = vVal * Me.Iva
            vTotale = vVal + vImposta
        End If
    End If

    Me.Importo = vVal
    Me.Imposta = vImposta
    Me.Totale = vTotale

End Sub

Private Sub Prezzo_AfterUpdate()

    Dim vVal, vImposta, vTotale As Currency
    vVal = 0#
    vImposta = 0#
    vTotale = 0#
    If Not IsNull(Me!IDArticolo) Then
        vVal = Me.Prezzo
        If Not IsNull(Me.Quantità) And Me.Quantità <> "" Then
            vVal = vVal * CSng(Me.Quantità)
            vImposta = vVal * Me.Iva
            vTotale = vVal + vImposta
        End If
    End If

    Me.Importo = vVal
    Me.Imposta = vImposta
    Me.Totale = vTotale

End Sub

Private Sub Quantità_AfterUpdate()

    Dim myData As dao.Database, strSQL As String, dGia As Single
    Dim myCar As dao.Recordset, mySca As dao.Recordset,
          myRese As dao.Recordset

    Set myData = CurrentDb
    strSQL = "SELECT Sum(SottoCarichi.Qt) AS TotCar
        FROM SottoCarichi " _
        & "WHERE SottoCarichi.IDArticolo = " & Me!IDArticolo
    Set myCar = myData.OpenRecordset(strSQL)
    strSQL = "SELECT Sum(SottoScarichi.Qt) AS TotSca
        FROM SottoScarichi " _
        & "WHERE SottoScarichi.IDArticolo = " & Me!IDArticolo
    Set mySca = myData.OpenRecordset(strSQL)
    strSQL = "SELECT Sum(SottoRese.Qt) AS TotRese
        FROM SottoRese " _
        & "WHERE SottoRese.IDArticolo = " & Me!IDArticolo
    Set myRese = myData.OpenRecordset(strSQL)

    dGia = 0#
    If Not IsNull(myCar!TotCar) Then
        dGia = dGia + myCar!TotCar
    End If
    If Not IsNull(mySca!TotSca) Then
        dGia = dGia - mySca!TotSca
    End If
    If Not IsNull(myRese!TotRese) Then
        dGia = dGia + myRese!TotRese
    End If

    mySca.Close
    myCar.Close
    myRese.Close
    Set myData = Nothing
    If Not IsNull(Me.Quantità.Text) Then
        If Me.Quantità.Text <> "" Then
            Me.Giacenza = dGia + CSng(Me.Quantità.Text)
        Else
            Me.Giacenza = dGia
        End If
    Else
        Me.Giacenza = dGia
    End If

    Dim vVal, vImposta, vTotale As Currency
    vVal = 0#
    vImposta = 0#
    vTotale = 0#
    If Not IsNull(Me!IDArticolo) Then
        vVal = Me.Prezzo
        If Not IsNull(Me.Quantità) And Me.Quantità <> "" Then
            vVal = vVal * CSng(Me.Quantità)
            vImposta = vVal * Me.Iva
            vTotale = vVal + vImposta
        End If
    End If

    Me.Importo = vVal
    Me.Imposta = vImposta
    Me.Totale = vTotale

End Sub

Private Sub Matricola_Articolo_AfterUpdate()

    If IsNull(Me!IDArticolo) Then Exit Sub

    Dim lVal As Long, fScorta As Single

    lVal = DLookup("IDUM", "Articoli",
     "IDArticolo = " & Me!IDArticolo)
    If Not IsNull(lVal) Then
        Me.Unità_di_Misura = lVal
    End If

    fScorta = DLookup("ScortaMin", "Articoli",
         "IDArticolo = " & Me!IDArticolo)
    If IsNull(fScorta) Then
        fScorta = 0#
    End If

    Dim myData As dao.Database, strSQL As String, dGia As Single
    Dim myCar As dao.Recordset, mySca As dao.Recordset,
          myRese As dao.Recordset

    Set myData = CurrentDb
    strSQL = "SELECT Sum(SottoCarichi.Qt) AS TotCar
        FROM SottoCarichi " _
        & "WHERE SottoCarichi.IDArticolo = " & Me!IDArticolo
    Set myCar = myData.OpenRecordset(strSQL)
    strSQL = "SELECT Sum(SottoScarichi.Qt) AS TotSca
      FROM SottoScarichi " _
        & "WHERE SottoScarichi.IDArticolo = " & Me!IDArticolo
    Set mySca = myData.OpenRecordset(strSQL)
    strSQL = "SELECT Sum(SottoRese.Qt) AS TotRese
      FROM SottoRese " _
        & "WHERE SottoRese.IDArticolo = " & Me!IDArticolo
    Set myRese = myData.OpenRecordset(strSQL)

    dGia = 0#
    If Not IsNull(myCar!TotCar) Then
        dGia = dGia + myCar!TotCar
    End If
    If Not IsNull(mySca!TotSca) Then
        dGia = dGia - mySca!TotSca
    End If
    If Not IsNull(myRese!TotRese) Then
        dGia = dGia + myRese!TotRese
    End If

    mySca.Close
    myCar.Close
    myRese.Close
    Set myData = Nothing

    Me.Giacenza = dGia
    Me.Scorta_Minima = fScorta
    Me.Prezzo = DLookup("Prezzo", "Articoli",
     "IDArticolo = " & Me!IDArticolo)
    Me.Iva = DLookup("Iva", "Articoli",
        "IDArticolo = " & Me!IDArticolo)

    Dim vVal, vImposta, vTotale As Currency
    vVal = 0#
    vImposta = 0#
    vTotale = 0#
    If Not IsNull(Me!IDArticolo) Then
        vVal = Me.Prezzo
        If Not IsNull(Me.Quantità) And Me.Quantità <> "" Then
            vVal = vVal * CSng(Me.Quantità)
            vImposta = vVal * Me.Iva
            vTotale = vVal + vImposta
        End If
    End If

    Me.Importo = vVal
    Me.Imposta = vImposta
    Me.Totale = vTotale

End Sub

Private Sub Matricola_Articolo_DblClick(Cancel As Integer)

    On Error GoTo Err_Codice_DblClick

    Dim lArt As Long

    lArt = 0
    If Not IsNull(Me!IDArticolo) Then
        lArt = Me!IDArticolo
        DoCmd.OpenForm "Articoli", , , , , acDialog, Me!IDArticolo
    Else
        DoCmd.OpenForm "Articoli", , , , , acDialog, "GoToNew"
    End If

    lArt = CLng(GetSetting("Calus", "RetVal", "Last", 0))
    DeleteSetting "Calus", "RetVal"
    If lArt <> 0 Then
        Me!IDArticolo = lArt

        Dim lUM As Long
        lUM = DLookup("IDUM", "Articoli", "IDArticolo = " & lArt)
        If Not IsNull(lUM) And lUM > 0 Then
            Me!IDUM = lUM
            Me.Unità_di_Misura.Requery
        End If
    End If
    Me.Descrizione_Articolo.Requery
    Me.Matricola_Articolo.Requery

Exit_Codice_DblClick:
    Exit Sub
Err_Codice_DblClick:
    MsgBox Err.Description
    Resume Exit_Codice_DblClick
End Sub

Private Sub Matricola_Articolo_NotInList(NewData As String,
      Response As Integer)
    MsgBox "Fare doppio click sul campo per inserire
        un nuovo articolo!"
    Response = acDataErrContinue
End Sub

Private Sub Unità_di_Misura_DblClick(Cancel As Integer)

    On Error GoTo Err_UniMis_DblClick

    Dim lUM As Long

    lUM = 0
    If Not IsNull(Me!IDUM) Then
        lUM = Me!IDUM
        DoCmd.OpenForm "UnMis", , , , , acDialog, Me!IDUM
    Else
        DoCmd.OpenForm "UnMis", , , , , acDialog, "GoToNew"
    End If

    lUM = CLng(GetSetting("Calus", "RetVal", "Last", 0))
    DeleteSetting "Calus", "RetVal"
    If lUM <> 0 Then Me!IDUM = lUM
    Me.Unità_di_Misura.Requery

Exit_UniMis_DblClick:
    Exit Sub
Err_UniMis_DblClick:
    MsgBox Err.Description
    Resume Exit_UniMis_DblClick

End Sub

Private Sub Unità_di_Misura_NotInList(NewData As String,
       Response As Integer)
    MsgBox "Fare doppio click sul campo per inserire
         una nuova unità di misura!"
    Response = acDataErrContinue
End Sub

<< Lezione Precedente – Inizio Tutorial – Lezione Successiva >>

Share
Giampaolo Rossi

Sviluppatore di software gestionale da oltre 28 anni.

Published by
Giampaolo Rossi
13 anni ago

Recent Posts

Un Abbonamento per Tutti i Software

Sono arrivato alla convinzione che un abbonamento per tutti i miei software gestionali sia il…

1 anno ago

Software di Magazzino Gratuito

MerciGest è un software per la gestione del magazzino completamente gratuito. Continua a leggere→

1 anno ago

Mettere il PC in Lock Screen

In ufficio può capitare di doversi allontanare dal proprio posto di lavoro, ecco che allora…

3 anni ago

Fare il reset togliendo la corrente

In questo articolo vedremo quando è più o meno utile togliere la corrente ad un…

3 anni ago

Prossimi Aggiornamenti Software

Dopo la pausa invernale dovuta al lavoro che devo fare per sostentarmi, eccomi di nuovo…

3 anni ago

Come Eliminare i Files in Windows

Vediamo come eliminare i files direttamente da Windows senza utilizzare il cestino. Continua a leggere→

4 anni ago