frm实施采购.frm

适合于中小型企业管理

         ItmX.SubItems(8) = IIf(LConRs!审核人 = Null, "0", LConRs!审核人)
         ItmX.SubItems(9) = IIf(LConRs!审核理由 = Null, "0", LConRs!审核理由)
        LConRs.MoveNext
    Loop
    If Not LConRs.EOF Then LConRs.MoveFirst
    lstContracts.Refresh
End Sub

Private Sub DoList1()
    Dim ItmX As ListItem
    ListView1.ColumnHeaders.Clear
    ListView1.ColumnHeaders.Add , , "申请编号", Len("申请编号") * 100 + 550 * 2
    ListView1.ColumnHeaders.Add , , "类别名称", Len("类别名称") * 100 + 550
    ListView1.ColumnHeaders.Add , , "物资编号", Len("物资编号") * 100 + 550
    ListView1.ColumnHeaders.Add , , "单价", Len("单价") * 100 + 550
    ListView1.ColumnHeaders.Add , , "数量", Len("数量") * 100 + 550
    ListView1.ColumnHeaders.Add , , "金额", Len("金额") * 100 + 550
    ListView1.ColumnHeaders.Add , , "业务员", Len("业务员") * 100 + 400
    ListView1.ColumnHeaders.Add , , "采购时间", Len("采购时间") + 550 * 2
    ListView1.ColumnHeaders.Add , , "仓库名称", Len("仓库名称") + 550 * 2
    ListView1.ColumnHeaders.Add , , "供货单位", Len("供货单位") + 550 * 2
    ListView1.ColumnHeaders.Add , , "备注", Len("备注") + 550 * 4

    ListView1.ListItems.Clear


    ListView1.Refresh
End Sub

Private Sub GetPayData()
Dim SqlString As Long

If Not lstContracts.ListItems.Count < 1 Then
    SqlString = Trim(lstContracts.SelectedItem.Text)
    LBindex = lstContracts.SelectedItem.Index

    Set ConPayRs = New ADODB.Recordset
    ConPayRs.Open "Select * from Fl_计划申请表 where 流程管理=1 and 流水号=" & SqlString, Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic, adCmdText
    Text3.Text = ConPayRs!申请数量
    LongSqsl = ConPayRs!申请数量
    LblBH.Caption = ConPayRs!申请编号
    WZlist ConPayRs!物资编号
End If
End Sub

Private Sub cmbPaperSizes_Click()
    Dim FormName As String
    FormName = Mid(cmbPaperSizes.Text, 1, InStr(1, cmbPaperSizes.Text, " -") - 1)
End Sub

Private Sub CmdAdd_Click()
   On Error GoTo Errline
    '检测是否符合要求
        If LBindex.Caption = "" Or Text4.Text = "" Or Text5.Text = "" Or combo1.ListIndex < 0 Then Exit Sub
        Text4.Text = Text2.Text * Text3.Text * 1
    For i = 1 To ListView1.ListItems.Count
        If ListView1.ListItems(i).Text = LblBH.Caption Then
            MsgBox "重复申请编号!"
            Exit Sub
        End If
    Next i

    '删除列表
    lstContracts.ListItems.Remove (CInt(LBindex.Caption))
    
    '添加至列表
        Set ItmX = ListView1.ListItems.Add(, , LblBH.Caption)
        ItmX.SubItems(1) = Text1(1).Text
        ItmX.SubItems(2) = Text1(0).Text
        ItmX.SubItems(3) = Text2.Text
        ItmX.SubItems(4) = Text3.Text
        ItmX.SubItems(5) = Text4.Text
        ItmX.SubItems(6) = Xtczy
        ItmX.SubItems(7) = Date
        ItmX.SubItems(8) = combo1.Text
        ItmX.SubItems(9) = Text5.Text
        ListView1.Refresh
    Text2.Text = ""
    Text3.Text = ""
    Text4.Text = ""
    LBindex.Caption = ""
    LSindex.Caption = ""
    LSString = ""
    Exit Sub
Errline:
    MsgBox "数据产生错误!"
    
End Sub

Private Sub CmdPrint_Click()
    Dim FormName As String
    
    FormName = Mid(cmbPaperSizes.Text, 1, InStr(1, cmbPaperSizes.Text, " -") - 1)
    Me.UseForm FormName
    
    CmdPrint.Enabled = False
End Sub

Private Sub CmdSave_Click()
On Error GoTo Errline
    Dim i As Integer
    '检测票据编号是否已经存在或空
    If Trim(RKTxt.Text) = "" Then
        MsgBox "票据编号不能为空!", vbCritical, "请重新填写!"
        Exit Sub
    Else
        Set RsPJBH = New ADODB.Recordset
        RsPJBH.Open "select * from Fl_采购票据表 where 票据编号='" & Trim(RKTxt.Text) & "'", Cw_DataEnvi.DataConnect, adOpenDynamic, adLockOptimistic, adCmdText
        If ListView1.ListItems.Count = 0 Then Exit Sub
        If RsPJBH.BOF And RsPJBH.EOF Then
            Dim CmdExe As ADODB.Command
            For i = 0 To ListView1.ListItems.Count - 1
                RsPJBH.AddNew
                    RsPJBH!申请编号 = ListView1.ListItems.Item(i + 1)
                    RsPJBH!票据编号 = Trim(RKTxt.Text)
                    RsPJBH!类别名称 = ListView1.ListItems.Item(i + 1).SubItems(1)
                    RsPJBH!物资编号 = ListView1.ListItems.Item(i + 1).SubItems(2)
                    RsPJBH!单价 = ListView1.ListItems.Item(i + 1).SubItems(3)
                    RsPJBH!数量 = ListView1.ListItems.Item(i + 1).SubItems(4)
                    RsPJBH!金额 = ListView1.ListItems.Item(i + 1).SubItems(5)
                    RsPJBH!业务员 = ListView1.ListItems.Item(i + 1).SubItems(6)
                    RsPJBH!采购时间 = ListView1.ListItems.Item(i + 1).SubItems(7)
                    RsPJBH!仓库名称 = ListView1.ListItems.Item(i + 1).SubItems(8)
                    RsPJBH!供货单位 = ListView1.ListItems.Item(i + 1).SubItems(9)
                    RsPJBH!打印状态 = 0
                    RsPJBH!票据状态 = 0
                    RsPJBH!备注 = " "
                    RsPJBH.Update
                
                Set CmdExe = New ADODB.Command
                CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
                CmdExe.CommandText = "update Fl_计划申请表 set 流程管理= '" & 2 & "' where 申请编号='" & ListView1.ListItems.Item(i + 1) & "'"
                CmdExe.Execute
            Next i
            CmdSave.Enabled = False
            CmdPrint.Enabled = True
            RKTxt.Enabled = False
            Command1.Enabled = False
            CmdAdd.Enabled = False
            combo1.Enabled = False
            Text5.Enabled = False
            MsgBox "票据信息存储完毕!"
        Else
            MsgBox "此票据编号已经存在!", vbCritical, "请重新填写!"
            Exit Sub
        End If
    End If
    RsPJBH.Close
    Set RsPJBH = Nothing
Exit Sub

Errline:
    MsgBox "请记住票据编号等相关信息,以便修正!", vbCritical, "异常错误"
    Exit Sub
End Sub

Private Sub Command1_Click()
    If LSindex.Caption = "" Then Exit Sub
    '删除列表
        ListView1.ListItems.Remove (CInt(LSindex.Caption))
    
    '添加至列表
        Set LConRs = New ADODB.Recordset
     LConRs.Open "SELECT * FROM Fl_计划申请表 where 流程管理=1 and 申请编号='" & LSString & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockOptimistic

        Set ItmX = lstContracts.ListItems.Add(, , LConRs!流水号)
          ItmX.SubItems(1) = LConRs!申请编号
         ItmX.SubItems(2) = LConRs!物资编号
         ItmX.SubItems(3) = LConRs!申请数量
         ItmX.SubItems(4) = LConRs!申请人
         ItmX.SubItems(5) = LConRs!申请时间
        If LConRs!流程管理 = "0" Then
            ItmX.SubItems(6) = "№"
        ElseIf LConRs!流程管理 = "1" Then
            ItmX.SubItems(6) = "㊣"
        ElseIf LConRs!流程管理 = "2" Then
            ItmX.SubItems(6) = "X"
        ElseIf LConRs!流程管理 = "3" Then
            ItmX.SubItems(6) = "√"
        End If
        ItmX.SubItems(7) = LConRs!申请理由
         ItmX.SubItems(8) = IIf(LConRs!审核人 = Null, "0", LConRs!审核人)
         ItmX.SubItems(9) = IIf(LConRs!审核理由 = Null, "0", LConRs!审核理由)
    
    
    
    LBindex.Caption = ""
    LSindex.Caption = ""
    LSString = ""
End Sub

Private Sub Command4_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    Dim ConPayRs As ADODB.Recordset
    SecWz = 1
    FLCount = 1
    Set ConPayRs = New ADODB.Recordset
    ConPayRs.Open "Select * from Fl_计划申请表 where 流程管理=1", Cw_DataEnvi.DataConnect, adOpenKeyset, adLockOptimistic, adCmdText
    DoList
    
    Set RsCk = New ADODB.Recordset
    RsCk.Open "SELECT MAX(票据编号) + 1 AS interID FROM Fl_采购票据表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdText
    RKTxt.Text = IIf(IsNull(RsCk!interID) = True, "1000000001", RsCk!interID)
    RsCk.Close
    
    Set RsCk = New ADODB.Recordset
    RsCk.Open "Fl_辅料仓库表", Cw_DataEnvi.DataConnect, adOpenStatic, adLockPessimistic, adCmdTable
    combo1.Clear
    Do While Not RsCk.EOF
        combo1.AddItem RsCk!仓库名称
        RsCk.MoveNext
    Loop
    
    DoList1
Dim NumForms As Long, i As Long
Dim FI1 As FORM_INFO_1
Dim aFI1() As FORM_INFO_1           ' Working FI1 array
Dim Temp() As Byte                  ' Temp FI1 array
Dim BytesNeeded As Long
Dim PrinterName As String           ' Current printer
Dim PrinterHandle As Long           ' Handle to printer
Dim FormItem As String              ' For ListBox
Dim RetVal As Long
Dim FormSize As SIZEL               ' Size of desired form

        'For jsqte = 0 To -1
        '    DyjCombo.AddItem Printer.DeviceName
        'Next jsqte

If OpenPrinter(PrinterName, PrinterHandle, 0&) Then
    With FormSize   ' Desired page size
        .cx = 121000
        .cy = 76500
    End With
    ReDim aFI1(1)
    RetVal = EnumForms(PrinterHandle, 1, aFI1(0), 0&, BytesNeeded, _
             NumForms)
    ReDim Temp(BytesNeeded)
    ReDim aFI1(BytesNeeded / Len(FI1))
    RetVal = EnumForms(PrinterHandle, 1, Temp(0), BytesNeeded, _
             BytesNeeded, NumForms)
    Call CopyMemory(aFI1(0), Temp(0), BytesNeeded)
    For i = 0 To NumForms - 1
        With aFI1(i)
            ' List name and size including the count (index).
            FormItem = PtrCtoVbString(.pName) & " - " & .Size.cx / 1000 & _
               " mm X " & .Size.cy / 1000 & " mm   (" & i + 1 & ")"
            cmbPaperSizes.AddItem FormItem
        End With
    Next i
    ClosePrinter (PrinterHandle)
    cmbPaperSizes.ListIndex = cmbPaperSizes.ListCount - 1
    
End If
End Sub

Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)
    If CmdPrint.Enabled = False And CmdSave.Enabled = False Then Exit Sub
        Dim SureQ As Integer
        SureQ = MsgBox("真的退出采购单据填写么(Y/N)？    ", vbYesNo + 32, "请确认...")
          If SureQ = 6 Then
             Cancel = 0
             Else
             Cancel = -1
          End If
End Sub

Private Sub ListView1_Click()
    If Not ListView1.ListItems.Count < 1 Then
        LSindex = ListView1.SelectedItem.Index
        LSString = ListView1.SelectedItem.Text
    End If
End Sub

Private Sub lstContracts_Click()
    GetPayData
End Sub

Private Sub RKTxt_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    End If
End Sub

Private Sub Text2_KeyPress(KeyAscii As Integer)

        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(Text2), ".") = 0 Then
                If Len(Trim(Text2)) > 0 Then
                    Text2.Locked = False
                Else
                    Text2.Locked = True
                End If
            Else
                Text2.Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            Text2.Locked = True
        Else
            Text2.Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            Text2.Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            Text2.Locked = False
        End If
End Sub

Private Sub Text2_LostFocus()
On Error Resume Next
    If Len(Text2.Text) < 1 Or Len(Text3.Text) < 1 Then
        Exit Sub
    Else
        Text4.Text = Text2.Text * Text3.Text * 1
    End If
End Sub

Private Sub Text3_KeyPress(KeyAscii As Integer)

        '小数点只允许输入一次
        If KeyAscii = 190 Then
            If InStr(Trim(Text3), ".") = 0 Then
                If Len(Trim(Text3)) > 0 Then
                    Text3.Locked = False
                Else
                    Text3.Locked = True
                End If
            Else
                Text3.Locked = True
            End If
            Exit Sub
        End If
        '非数字不能输入
        If KeyAscii > 57 Or KeyAscii < 48 Then
            Text3.Locked = True
        Else
            Text3.Locked = False
        End If
        '允许Backspace
        If KeyAscii = 8 Then
            Text3.Locked = False
        End If
        'Delete键
        If KeyAscii = 46 Then
            Text3.Locked = False
        End If
End Sub

Private Sub Text3_LostFocus()
On Error Resume Next
    If Len(Text2.Text) < 1 Or Len(Text3.Text) < 1 Then
        Exit Sub
    Else
        Text4.Text = Text2.Text * Text3.Text * 1
    End If
    If Text3.Text * 1 > LongSqsl Then
        MsgBox "采购数量必须不大于申请数量！", vbExclamation
        Text3.Text = LongSqsl
    End If
    
End Sub

Private Sub Text5_DblClick()
    Frm选择供货单位.Show 1
End Sub

Public Sub UseForm(FormName As String)
Dim RetVal As Integer

RetVal = SelectForm(FormName, Me.hwnd)
Select Case RetVal
    Case FORM_NOT_SELECTED   ' 0
        ' Selection failed!
        MsgBox "Unable to retrieve From name", vbExclamation, _
           "Operation halted!"
    Case FORM_SELECTED   ' 1
            PrintTest1
    Case FORM_ADDED   ' 2
        ' Form added and selected.
        Form_Load     ' by rebuilding the list.
End Select
End Sub