frmpandian.frm

通用书店管理系统

        '设置打印信息保存位置
        .strPrintInfoName = "上月盘点结果|" & Me.Caption
        
        .FormStart
        .Show vbModal
    End With
    Exit Sub
        
   End Select
err:
    MsgBox "打印出错！"
End Sub

Private Sub Form_Activate()
  SetToolBar ("0000X00X011X111")
End Sub

Private Sub Form_Load()
  Dim i As Integer
  Dim sqlstring As String
  Dim rstmp As New ADODB.Recordset
  Dim rsNewTmp As New ADODB.Recordset
  Dim rstWork As New ADODB.Recordset
  Dim intTotalAmount As Integer '保存数量
  
  On Error GoTo err
  sqlstring = "select * from PDControl"
  Set rstmp = New ADODB.Recordset
  
  strNowDate = Format(Date, "yyyy-mm-dd")
  
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If rstmp.EOF Then
     MsgBox "盘点控制表没有数据，请先设置好盘点控制表再进行盘点！", , "警告"
     Exit Sub
  Else
     strLastDate = rstmp.Fields("DatLast").Value
     strDefaultDate = Mid(strNowDate, 1, 7) & "-" & rstmp.Fields("intDefault").Value
  End If
  
  If Format(strNowDate, "yyyy-mm-dd") <> Format(strDefaultDate, "yyyy-mm-dd") Then
    MsgBox "今天不是默认盘点时间，不能进行盘点！", , "警告"
    Exit Sub
  End If
  
  If DateDiff("m", strLastDate, strNowDate) > 1 Then
    If MsgBox("盘点时间超过一个月，是否继续进行盘点？", vbYesNo) = vbNo Then
       Exit Sub
    End If
  ElseIf DateDiff("m", strLastDate, strNowDate) < 0 Then
    MsgBox "盘点时间比上次盘点时间早，操作不能进行！", , "警告"
    Exit Sub
  End If
  
  '本月是否进行过手工盘点
  sqlstring = "select * from MonthlyPDInput where chrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If rstmp.EOF Then
     MsgBox "本月盘点信息录入表中没有数据，盘点操作不能进行！", , "警告"
     Exit Sub
  End If
    
  '判断是否第一次使用盘点,是则将目前库存作为上次盘点数保存
  sqlstring = "select * from PDResult where chrPDdate=#" & Format(strLastDate, "yyyy-mm-dd") & "#"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  
  If rstmp.EOF Then
     sqlstring = "select * from BookStorage order by chrBookNo,chrBookName"
     Set rstWork = New ADODB.Recordset
     rstWork.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
     Do While Not rstWork.EOF
        sqlstring = "insert into PDResult(ChrPDDate,chrBookNo,chrBookName,chrStorageNo,intAmount,intFactAmount," & _
                    "intMonthAdd,intMonthAmount) values (#" & Format(strLastDate, "yyyy-mm-dd") & _
                    "#,'" & rstWork.Fields("chrBookNo") & "','" & rstWork.Fields("chrBookName") & "','" & _
                    rstWork.Fields("chrStorageNo") & "'," & rstWork.Fields("IntAmount") & "," & rstWork.Fields("intAmount") & _
                    ",0,0)"
        cN.Execute sqlstring
        rstWork.MoveNext
     Loop
  End If
  
  
  sqlstring = "select * from PDResult where ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
  Set rstmp = New ADODB.Recordset
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  If Not rstmp.EOF Then
     If MsgBox("本月已经进行过盘点，需删除记录重新盘点吗", vbYesNo) = vbYes Then
        sqlstring = "delete from PDResult where ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
        cN.Execute sqlstring
     Else
        '显示盘点结果
        Set rstmp = New ADODB.Recordset
        sqlstring = "select t1.*,t2.chrStorageName from PDResult t1 left join StorageSection t2 on " & _
                    " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Set tdbStorageInput(0).DataSource = rstmp
        
        Set rstmp = New ADODB.Recordset
        sqlstring = "select t1.*,t2.chrStorageName from MonthlyPDInput t1 left join StorageSection t2 on " & _
                    " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Set tdbStorageInput(1).DataSource = rstmp
        
        Set rstmp = New ADODB.Recordset
        sqlstring = "select t1.*,t2.chrStorageName from PDResult t1 left join StorageSection t2 on " & _
                    " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(DateAdd("m", -1, strNowDate), "yyyy-mm-dd") & "#"
        rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        Set tdbStorageInput(2).DataSource = rstmp
        Exit Sub
     End If
  End If
  
  sqlstring = "select distinct chrStorageNo from BookStorage order by ChrStorageNo"
  Set rsNewTmp = New ADODB.Recordset
  rsNewTmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  cN.BeginTrans
  Do While Not rsNewTmp.EOF
        '从库存表中获取该库区所有库存图书的信息
        sqlstring = "select * from BookStorage where chrStorageNo='" & rsNewTmp.Fields("chrStorageNo") & "'"
        Set rstWork = New ADODB.Recordset
        rstWork.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
        
        
        If Not rstWork.EOF Then
            frmMain.prgBar.Max = rstWork.Recordcount
        Else
            frmMain.prgBar.Max = 1
        End If
        
        i = 0
        Do While Not rstWork.EOF
            intTotalAmount = 0
            '盘入库单明细
            sqlstring = "select chrBookNo,chrBookName,sum(IntSSS) as intTotal from( select t1.* from InstorageInformation_List t1 left outer join InstorageInformation t2 on " & _
                     " t1.ChrRKDH=t2.ChrRKDH where t2.DatCheckDate between #" & strLastDate & "# and #" & strNowDate & _
                     "# and t2.ChrStorageNo='" & Trim(rsNewTmp.Fields("ChrStorageNo")) & "' and t1.chrBookNo='" & rstWork.Fields("chrBookNo").Value & _
                     "' and t1.chrBookName='" & rstWork.Fields("chrBookName") & "' )A group by chrBookNo,chrBookName  "
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            
            If Not rstmp.EOF Then
              intTotalAmount = intTotalAmount + IIf(IsNull(rstmp.Fields("intTotal").Value), 0, rstmp.Fields("intTotal"))
            End If
            
            '盘出库单明细(入库)
            sqlstring = "select chrBookNo,chrBookName,sum(IntAmount) as intTotal from (select t1.* from OutstorageInformation_List t1 left outer join OutstorageInformation t2 on " & _
                     " t1.ChrCKDH=t2.ChrCKDH where t2.DatSPDate between #" & strLastDate & "# and #" & strNowDate & _
                     "# and t2.ChrStorageNo2='" & Trim(rsNewTmp.Fields("ChrStorageNo")) & "'  and t1.chrBookNo='" & rstWork.Fields("chrBookNo").Value & _
                     "' and t1.chrBookName='" & rstWork.Fields("chrBookName") & "' )A group by chrBookNo,chrBookName"
                     
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            
            If Not rstmp.EOF Then
              intTotalAmount = intTotalAmount + IIf(IsNull(rstmp.Fields("intTotal").Value), 0, rstmp.Fields("intTotal"))
            End If
            
            '盘出库单明细（出库）
            sqlstring = "select chrBookNo,chrBookName,sum(intAmount) as intTotal from (select t1.* from OutstorageInformation_List t1 left outer join OutstorageInformation t2 on " & _
                     " t1.ChrCKDH=t2.ChrCKDH where t2.DatSPDate between #" & strLastDate & "# and #" & strNowDate & _
                     "# and t2.ChrStorageNo1='" & Trim(rsNewTmp.Fields("ChrStorageNo")) & "'  and t1.chrBookNo='" & rstWork.Fields("chrBookNo").Value & _
                     "' and t1.chrBookName='" & rstWork.Fields("chrBookName") & "' )A group by chrBookNo,chrBookName"
                     
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
                     
            If Not rstmp.EOF Then
              intTotalAmount = intTotalAmount - IIf(IsNull(rstmp.Fields("intTotal").Value), 0, rstmp.Fields("intTotal"))
            End If
                     
            '盘销售数量
            sqlstring = "select chrBookNo,chrBookName,sum(intAmount) as intTotal from (select t1.* from SellTable_List t1 left outer join SellTable t2 on " & _
                     " t1.ChrSellNo=t2.ChrSellNo where t2.DatDate between #" & strLastDate & "# and #" & strNowDate & _
                     "# and t2.ChrStorageNo='" & Trim(rsNewTmp.Fields("ChrStorageNo")) & "'  and t1.chrBookNo='" & rstWork.Fields("chrBookNo").Value & _
                     "' and t1.chrBookName='" & rstWork.Fields("chrBookName") & "'  ) A group by chrBookNo,chrBookName"
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            
            If Not rstmp.EOF Then
              intTotalAmount = intTotalAmount - IIf(IsNull(rstmp.Fields("intTotal").Value), 0, rstmp.Fields("intTotal"))
            End If
            
            '盘销售退书数量
            sqlstring = "select chrBookNo,chrBookName,sum(intAmount) as intTotal from (select t1.* from TuiShuTable_List t1 left outer join TuiShuTable t2 on " & _
                     " t1.ChrTuiShuNo=t2.ChrTuiShuNo where t2.DatTSDate between #" & strLastDate & "# and #" & strNowDate & _
                     "# and t2.ChrStorageNo='" & Trim(rsNewTmp.Fields("ChrStorageNo")) & "'  and t1.chrBookNo='" & rstWork.Fields("chrBookNo").Value & _
                     "' and t1.chrBookName='" & rstWork.Fields("chrBookName") & "' )A group by chrBookNo,chrBookName "
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            
            If Not rstmp.EOF Then
              intTotalAmount = intTotalAmount + IIf(IsNull(rstmp.Fields("intTotal").Value), 0, rstmp.Fields("intTotal"))
            End If
            
            '查询手工盘点数量
            sqlstring = "select * from MonthlyPDInput where chrPDDate=#" & Format(strNowDate, "yyyy-mm") & _
                      "# and chrStorageNo='" & rsNewTmp.Fields("chrStorageNO") & "' and chrBookNo='" & rstWork.Fields("chrBookNo") & _
                      "' and chrBookName='" & rstWork.Fields("chrBookName") & "'"
            Set rstmp = New ADODB.Recordset
            rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
            
            If Not rstmp.EOF Then
                sqlstring = "insert into PDResult(ChrPDDate,chrBookNo,chrBookName,chrStorageNo,intAmount,intFactAmount,intMonthAdd,intMonthAmount) values " & _
                          "(#" & Format(strNowDate, "yyyy-mm-dd") & "#,'" & rstWork.Fields("chrBookNo") & _
                          "','" & rstWork.Fields("chrBookName") & "','" & rsNewTmp.Fields("chrStorageNo") & _
                          "'," & rstWork.Fields("intAmount") & "," & rstmp.Fields("intAmount") & "," & _
                          intTotalAmount & "," & CInt(rstWork.Fields("intAmount") - rstmp.Fields("intAmount")) & ")"
            Else
                sqlstring = "insert into PDResult(ChrPDDate,chrBookNo,chrBookName,chrStorageNo,intAmount,intFactAmount,intMonthAdd,intMonthAmount) values " & _
                          "(#" & Format(strNowDate, "yyyy-mm-dd") & "#,'" & rstWork.Fields("chrBookNo") & _
                          "','" & rstWork.Fields("chrBookName") & "','" & rsNewTmp.Fields("chrStorageNo") & _
                          "'," & rstWork.Fields("intAmount") & "," & rstWork.Fields("intAmount") & "," & _
                          intTotalAmount & ",0)"
            End If
            cN.Execute sqlstring
            
            rstWork.MoveNext
            Call ShowBar(i, True)
            i = i + 1
        Loop
        Call ShowBar(1, False)
        rsNewTmp.MoveNext
  Loop
  
  sqlstring = "update PDControl set DatLast=#" & strNowDate & "#"
  cN.Execute sqlstring
  cN.CommitTrans
  Call ShowBar(1, False)
  
  
  '显示盘点结果
  Set rstmp = New ADODB.Recordset
  sqlstring = "select t1.*,t2.chrStorageName from PDResult t1 left join StorageSection t2 on " & _
              " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Set tdbStorageInput(0).DataSource = rstmp
  
  Set rstmp = New ADODB.Recordset
  sqlstring = "select t1.*,t2.chrStorageName from MonthlyPDInput t1 left join StorageSection t2 on " & _
              " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(strNowDate, "yyyy-mm-dd") & "#"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Set tdbStorageInput(1).DataSource = rstmp
  
  Set rstmp = New ADODB.Recordset
  sqlstring = "select t1.*,t2.chrStorageName from PDResult t1 left join StorageSection t2 on " & _
              " t1.chrStorageNo=t2.chrStorageNo where t1.ChrPDDate=#" & Format(strLastDate, "yyyy-mm-dd") & "#"
  rstmp.Open sqlstring, cN, adOpenKeyset, adLockReadOnly
  Set tdbStorageInput(2).DataSource = rstmp
  
  Exit Sub
err:
  cN.RollbackTrans
  MsgBox err.Description, vbInformation
End Sub

Private Sub Form_Unload(Cancel As Integer)
  SetToolBar ("0000X00X001X111")
End Sub