frm_part_inout.frm

汽修厂管理软件

Comb_way.ListIndex = 0
Exit Sub
End If
ErrHandle:
 If strOkorEsc = "确定" Then MsgBox Err.Description, vbCritical + vbOKOnly, STRGARAGE
Fianal:
 Unload Me
End Sub

Sub loadFields()
Dim intFields As Integer
Dim intFlexFields As Integer
Dim i As Integer
Dim Fieldi As Integer
Dim sngFlexCellWidth() As Single
Dim sngScaleWidth As Single
Dim RsWorker As Recordset
Dim intCaiGouRen As Integer
Dim intZhuZhangRen As Integer
Dim intZhiJianRen As Integer
Dim intDengJiRen As Integer
intFields = mRSHardware.Fields.Count
intFlexFields = 6 '可以调整显示的Fields数目
ReDim sngFlexCellWidth(intFlexFields)
Grid_Part_InOut.Cols = intFlexFields
sngScaleWidth = 0
For Fieldi = 0 To mRSHardware.Fields.Count - 1
  If Fieldi < intFlexFields Then
   Grid_Part_InOut.TextMatrix(0, Fieldi) = mRSHardware.Fields(Fieldi).Name
   If mRSHardware.Fields(Fieldi).Type = 4 Or mRSHardware.Fields(Fieldi).Type = 5 Then
       sngFlexCellWidth(Fieldi) = mRSHardware.Fields(Fieldi).Size * 2
       sngScaleWidth = sngScaleWidth + sngFlexCellWidth(Fieldi)
     Else
       sngFlexCellWidth(Fieldi) = mRSHardware.Fields(Fieldi).Size
       sngScaleWidth = sngScaleWidth + sngFlexCellWidth(Fieldi)
   End If
  End If
Next Fieldi
For Fieldi = 0 To mRSHardware.Fields.Count - 1
  If Fieldi < intFlexFields Then
   Grid_Part_InOut.ColWidth(Fieldi) = (Grid_Part_InOut.Width - 500) * (sngFlexCellWidth(Fieldi) / sngScaleWidth)
  End If
Next Fieldi
 '加载个文本框和下拉框,各控件长度根据表中各短竖线位置自动调整
 ReDim mOcxArray(intFields) As Object
 
 For Fieldi = 0 To mRSHardware.Fields.Count - 1
    If InStr(1, mRSHardware.Fields(Fieldi).Name, "商") > 0 Or InStr(1, mRSHardware.Fields(Fieldi).Name, "人") > 0 Then
        If Fieldi <> 0 Then
         Load Comb_Array(Fieldi)
             
         Set mOcxArray(Fieldi) = Comb_Array(Fieldi)
         
          
             
          Else
         
         Set mOcxArray(Fieldi) = Comb_Array(Fieldi)
         
        End If
   
      
      
        
        
        
    Else
       If Fieldi <> 0 Then
           Load Txt_Array(Fieldi)
           Set mOcxArray(Fieldi) = Txt_Array(Fieldi)
          
         Else
           Set mOcxArray(Fieldi) = Txt_Array(Fieldi)
            mOcxArray(Fieldi).Tag = mRSHardware.Fields(Fieldi).Name
        End If
    End If
       mOcxArray(Fieldi).Left = Line_Array(Fieldi).X2 + 50
       mOcxArray(Fieldi).Top = Line_Array(Fieldi).Y2 - 120 - 270
      ' mOcxArray(Fieldi).Height = 270
      If Line_Array(Fieldi + 1).Y2 = Line_Array(Fieldi).Y2 Then
        mOcxArray(Fieldi).Width = Line_Array(Fieldi + 1).X2 - Line_Array(Fieldi).X2 - 100
       Else
         mOcxArray(Fieldi).Width = Shape1.Left + Shape1.Width - Line_Array(Fieldi).X2 - 100
       End If
       
       mOcxArray(Fieldi).Visible = True
       'mOcxArray(Fieldi).enable = True
       mOcxArray(Fieldi).Text = ""
      
       Select Case mRSHardware.Fields(Fieldi).Name
       Case "采购人"
         intCaiGouRen = Fieldi
       Case "质检人"
         intZhiJianRen = Fieldi
       Case "主张人"
         intZhuZhangRen = Fieldi
       Case "登记人"
         intDengJiRen = Fieldi
       Case "配件名称"
         mintField_PartName = Fieldi
       Case "数量"
         mIntField_PartSum = Fieldi
       Case "成本"
         mIntField_PartInPrice = Fieldi
       Case "单价"
         mIntField_PartSalePrice = Fieldi
       Case "ID"
         mIntField_PartId = Fieldi
       Case "入库日期"
         mIntField_PartInDate = Fieldi
       Case "规格"
         mIntField_PartType = Fieldi
       Case "出库日期"
         mIntField_PartOutDate = Fieldi
       Case "同品种ID"
         mIntField_PartSameId = Fieldi
       Case "零配件批发商"
         mIntField_PartSaler = Fieldi
       End Select
       
      
  Next Fieldi
  
   '为表格中的下拉框加载项目
   Set RsWorker = DBSGRG.OpenRecordset("职员表")
       For i = 0 To RsWorker.RecordCount - 1
         For Fieldi = 0 To RsWorker.Fields.Count - 1
           Select Case RsWorker.Fields(Fieldi).Name
            Case "零配件采购人"
              If RsWorker.Fields(Fieldi).Value = True Then
              mOcxArray(intCaiGouRen).AddItem RsWorker.Fields("姓名")
             If mOcxArray(intCaiGouRen).Text = "" Then mOcxArray(intCaiGouRen).Text = RsWorker.Fields("姓名")
              End If
            Case "零配件质检人"
              If RsWorker.Fields(Fieldi).Value = True Then
               mOcxArray(intZhiJianRen).AddItem RsWorker.Fields("姓名")
              If mOcxArray(intZhiJianRen).Text = "" Then mOcxArray(intZhiJianRen).Text = RsWorker.Fields("姓名")
              End If
            Case "零配件主张人"
              If RsWorker.Fields(Fieldi).Value = True Then
              mOcxArray(intZhuZhangRen).AddItem RsWorker.Fields("姓名")
              If mOcxArray(intZhuZhangRen).Text = "" Then mOcxArray(intZhuZhangRen).Text = RsWorker.Fields("姓名")
              End If
            Case "仓管登记人"
              If RsWorker.Fields(Fieldi).Value = True Then
              mOcxArray(intDengJiRen).AddItem RsWorker.Fields("姓名")
              If mOcxArray(intDengJiRen).Text = "" Then mOcxArray(intDengJiRen).Text = RsWorker.Fields("姓名")
              End If
             End Select
         Next Fieldi
         RsWorker.MoveNext
       Next i
       RsWorker.Close
  
End Sub


Private Sub Grid_Part_InOut_Click()
'显示有关该零部件的细节
                                     
Call ShowPartById(CLng(Grid_Part_InOut.TextMatrix(Grid_Part_InOut.Row, 0)))

End Sub


Sub ShowPartById(Id As Long)
Dim i As Integer
Dim Rs_Id As Recordset
'EG.  Set mRsWaiting = DBSGRG.OpenRecordset("Select *  from " & TblWait & " where 车牌 = '" & STRCURRENTCARNUMBER & "'", dbOpenDynaset)
  
Set Rs_Id = DBSGRG.OpenRecordset("Select * from " & TblWareHouse & " where ID = " & _
                                     Id, dbOpenDynaset)


If Rs_Id.RecordCount = 0 Then Exit Sub
For i = 0 To Rs_Id.Fields.Count - 1
 mOcxArray(i).Text = Rs_Id.Fields(i) & ""
Next i

Rs_Id.Close
End Sub


Function Validate() As Boolean
 Dim i As Integer
 Dim RsV As Recordset
  Validate = True
 For i = 1 To 4
    If mOcxArray(i).Text = "" Or mOcxArray(i).Text = Null Then
     Validate = False
   End If
 Next i

End Function

Sub PartInOut(KcsAction As Long, PartId As Integer)
Dim Rs_Part As Recordset
Dim inDate As Date
Dim strIn_Out As String
Dim sngMoney As Single
Dim sngSum As Single
Dim strWay As String
Dim strBuyReason As String
Dim strBuyer As String
Dim strZhuZhangRen As String
Dim strQ As String
Dim intNotEdit2 As Integer
Dim strSMS As String
Dim pPartName As Parameter
Dim boSame As Boolean
Dim lngSameId As Long
Dim strPartSaler As String
Dim sngRealMoney As Single
Dim sngYuanLaiShuLiang
Dim CurMaoLi As Currency
Dim strReaSon As String
'On Error GoTo ErrHandle
'kcsbuypart=1;kcssalepart=2;kcsbackpart =3;KcsDisCard=4;KcsForWeixiu;KcsAdd:购买同品种
If Validate() = False Then
          Call MsgBox("你还未填完数据,请重新填写", vbCritical + vbOKOnly, STRGARAGE)
          Exit Sub
End If
Select Case KcsAction
   Case KcsBuyPart
       strQ = "您确定以" & Comb_way.Text & "的方式另行购买" & mOcxArray(mIntField_PartSum).Text & "个/只" & mOcxArray(mintField_PartName).Text & "吗?"
        sngMoney = CInt(mOcxArray(mIntField_PartSum).Text) * CSng(mOcxArray(mIntField_PartInPrice).Text)
   Case KcsSalePart
       strQ = "您确定以" & Comb_way.Text & "的方式销售" & mOcxArray(mintField_PartName).Text & "(ID:" & mOcxArray(mIntField_PartId).Text & ")" & mOcxArray(mIntField_PartSum).Text & "个/只" & ")吗?"
       sngMoney = CInt(mOcxArray(mIntField_PartSum).Text) * CSng(mOcxArray(mIntField_PartSalePrice).Text)
   Case KcsBackPart
       strQ = "您确定以" & Comb_way.Text & "的方式退货" & mOcxArray(mintField_PartName).Text & "(ID:" & mOcxArray(mIntField_PartId).Text & ")" & mOcxArray(mIntField_PartSum).Text & "个/只" & ")吗?"
        sngMoney = CInt(mOcxArray(mIntField_PartSum).Text) * CSng(mOcxArray(mIntField_PartSalePrice).Text)
   Case KcsDisCardPart
       strQ = "您确定报废" & mOcxArray(mintField_PartName).Text & "(ID:" & mOcxArray(mIntField_PartId).Text & ")" & mOcxArray(mIntField_PartSum).Text & "个/只" & ")吗?"
   Case KcsAdd
       strQ = "您确定以" & Comb_way.Text & "的方式购买" & "(ID:" & mOcxArray(mIntField_PartId).Text & ")" & mOcxArray(mIntField_PartSum).Text & "个/只" & mOcxArray(mintField_PartName).Text & "吗?"
        sngMoney = CInt(mOcxArray(mIntField_PartSum).Text) * CSng(mOcxArray(mIntField_PartSalePrice).Text)
End Select
strReaSon = Mid(strQ, 4)
strReaSon = Left(strReaSon, Len(strReaSon) - 2)
If MsgBox(strQ, vbQuestion + vbOKCancel) = vbCancel Then Exit Sub
If KcsAction = KcsBuyPart Or KcsAction = KcsSalePart Or KcsAction = KcsBackPart Or KcsAction = KcsAdd Then '计算金额
If KcsAction = KcsSalePart Then '计算毛利
 CurMaoLi = CSng(mOcxArray(mIntField_PartSum).Text) * (CSng(mOcxArray(mIntField_PartSalePrice).Text) - CSng(mOcxArray(mIntField_PartInPrice).Text))
End If
If Comb_way.Text = "现金" Then
        Frm_Part_SumPrice.Label4.Caption = "元"
        Frm_Part_SumPrice.lbl_Title = "购销货品"
        Frm_Part_SumPrice.Lbl_Sum.Caption = "应" & strIn_Out
        Frm_Part_SumPrice.lbl_SinglePrice.Caption = "实际" & strIn_Out
        Frm_Part_SumPrice.Txt_PartSum.Locked = True
        Frm_Part_SumPrice.Txt_PartSum.Text = CStr(sngMoney)
        Frm_Part_SumPrice.Txt_Price.Text = CStr(sngMoney)
        Frm_Part_SumPrice.Txt_Price.SelStart = 0
        'Frm_Part_SumPrice.Txt_Price.SelLength = Len(Frm_Part_SumPrice.Txt_Price.Text)
        Frm_Part_SumPrice.Lbl_Way.Visible = True
        Frm_Part_SumPrice.Comb_way.Visible = True
        Frm_Part_SumPrice.Comb_way.Text = strWay
        Frm_Part_SumPrice.Show vbModal
        If Frm_Part_SumPrice.Dicision = False Then Exit Sub             '按取消什么都不做
        Set Rs_Part = DBSGRG.OpenRecordset(TblFinance, dbOpenDynaset)
        sngRealMoney = CSng(Frm_Part_SumPrice.Txt_Price.Text)
        strIn_Out = "收入"
        If KcsAction = KcsBuyPart Then strIn_Out = "支出"
        With Rs_Part
           .MoveLast
            MsgBox "这笔财务记录ID号为" & CStr(.Fields("ID") + 1), vbOKOnly, STRGARAGE
           .AddNew
           .Fields("日期") = Date
           .Fields("标的金额") = sngMoney
           .Fields("交易方式") = Comb_way.Text
           .Fields("活动原因") = strReaSon
           .Fields("经手人") = strBuyer
           .Fields("批准人") = strZhuZhangRen
           .Fields("出入帐") = strIn_Out
           .Fields("对方") = strPartSaler
           .Fields("实际金额") = sngRealMoney
           .Fields("毛利") = CurMaoLi
           .Fields("账目种类") = "汽配进销"
           .Update
           .Close
        End With
                
    End If
 End If
    
 '******************根据情况更改库存记录**************************
 If KcsAction = KcsBuyPart Then
    Set Rs_Part = DBSGRG.OpenRecordset(TblWareHouse, dbOpenDynaset)
    Rs_Part.AddNew
    For i = 1 To Rs_Part.Fields.Count - 1
              If i = intNotEdit Then Rs_Part.Fields(i) = Date
              If i <> mIntField_PartId And i <> intNotEdit Then
                Select Case Rs_Part.Fields(i).Type
                  Case dbMemo
                    Rs_Part.Fields(i) = mOcxArray(i).Text
                  Case dbChar
                    Rs_Part.Fields(i) = mOcxArray(i).Text
                  Case dbCurrency
                    Rs_Part.Fields(i) = CSng(mOcxArray(i).Text)
                  Case dbDate '什么都不做
                   ' Rs_Part.Fields(i) = CDate(mOcxArray(i).Text)
                  Case dbLong
                    If mOcxArray(i).Text = Null Or mOcxArray(i).Text = "" Then
                     Rs_Part.Fields(i) = 0
                     Else
                     Rs_Part.Fields(i) = CLng(mOcxArray(i).Text)
                    End If
                  Case dbText
                    Rs_Part.Fields(i) = CStr(mOcxArray(i).Text)
                End Select
              End If
    Next i
 
    Rs_Part.Update
    Rs_Part.MoveLast
    strBuyer = Rs_Part.Fields("采购人")
    strWay = Comb_way.Text
    strZhuZhangRen = Rs_Part.Fields("主张人") & ""
    strPartSaler = Rs_Part.Fields("零件批发商")
    Rs_Part.Close
    
 End If
 
 If KcsAction = KcsBackPart Or KcsAction = KcsDisCardPart Then
    Set Rs_Part = DBSGRG.OpenRecordset("Select * from " & TblWareHouse & " where ID = " & _
                                     CLng(mOcxArray(mIntField_PartId).Text), dbOpenDynaset)
    sngYuanLaiShuLiang = Rs_Part.Fields("数量")
    Rs_Part.Edit
    
    Rs_Part.Fields("数量") = sngYuanLaiShuLiang - CInt(mOcxArray(mIntField_PartSum).Text)
    
    
    Rs_Part.Update
    Rs_Part.Close
 End If
 If KcsAction = KcsAdd Or KcsAction = KcsSalePart Then
    Set Rs_Part = DBSGRG.OpenRecordset("Select * from " & TblWareHouse & " where ID = " & _
                                     CLng(mOcxArray(mIntField_PartId).Text), dbOpenDynaset)
   sngYuanLaiShuLiang = Rs_Part.Fields("数量")
    Rs_Part.Edit
    For i = 1 To Rs_Part.Fields.Count - 1
              If i = intNotEdit Then Rs_Part.Fields(i) = Date
              If i <> mIntField_PartId And i <> intNotEdit Then
                Select Case Rs_Part.Fields(i).Type
                  Case dbMemo
                    Rs_Part.Fields(i) = mOcxArray(i).Text
                  Case dbChar
                    Rs_Part.Fields(i) = mOcxArray(i).Text
                  Case dbCurrency
                    Rs_Part.Fields(i) = CSng(mOcxArray(i).Text)
                  Case dbDate '什么都不做
                   ' Rs_Part.Fields(i) = CDate(mOcxArray(i).Text)
                  Case dbLong
                    If mOcxArray(i).Text = Null Or mOcxArray(i).Text = "" Then
                     Rs_Part.Fields(i) = 0
                     Else
                     Rs_Part.Fields(i) = CLng(mOcxArray(i).Text)
                    End If
                  Case dbText
                    Rs_Part.Fields(i) = CStr(mOcxArray(i).Text)
                End Select
              End If
    Next i
     If KcsAction = KcsAdd Then Rs_Part.Fields("数量") = sngYuanLaiShuLiang + CInt(mOcxArray(mIntField_PartSum).Text)
    If KcsAction = KcsSalePart Then Rs_Part.Fields("数量") = sngYuanLaiShuLiang - CInt(mOcxArray(mIntField_PartSum).Text)
    Rs_Part.Update
    Rs_Part.Close
 End If

Exit Sub

ErrHandle:
 If Err.Number = 3033 Then
    Call MsgBox("您没有权限!", vbOKOnly + vbInformation, STRGARAGE)
  Else
     Call MsgBox(Err.Description, vbOKOnly + vbInformation, STRGARAGE)
 End If
End Sub

Private Sub Grid_Part_InOut_MouseDown(Button As Integer, Shift As Integer, X As Single, Y As Single)
If Button = 2 And Grid_Part_InOut.Row > 0 Then
 ' Me.PopupMenu mnuPop
End If

End Sub

Private Sub mnuInmerge_Click()
Dim lngSelectId As Integer
Dim str2Id As String
Dim lng2Id As Long
 
 lngSelectId = CLng(Grid_Part_InOut.TextMatrix(Grid_Part_InOut.Row, 0))
 str2Id = InputBox("将" & Grid_Part_InOut.TextMatrix(Grid_Part_InOut.Row, 1) & "(ID: " & CStr(lngSelectId) & ")合并到ID:", strgerage)
 
 
End Sub