Stock Movements in a Management Program

Posted on June 14, 2013 by giampy107

We continue our program for the creation of the warehouse Calus 2012 seeing how to insert windows to management of loading and unloading goods. Here’s how we create our window, in particular use the main pattern and detail.

Loads

Window to manage the loading of goods

To build this type of window we need a main form that contains a sub-form for details. In addition to fields such as number and date of movement, the main window has to filter the data, here is the VBA code:

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 "Double click the field to enter
          a new unit of measurement!"
    Response = acDataErrContinue
End Sub

<< Previous Lesson – Start Tutorial

This entry was posted in Database. Bookmark the permalink.