frm票据查询.frm

适合于中小型企业管理

    ListView1.ColumnHeaders.Add , , "票据", Len("状态") + 550
    ListView1.ColumnHeaders.Add , , "备注", Len("备注") + 1800

    ListView1.ListItems.Clear


    ListView1.Refresh
End Sub

Private Sub RdoList()
    DoList
    If Not lstContracts.ListItems.Count < 1 Then
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM FL_辅料出库表 where 票据编号='" & Trim(lstContracts.SelectedItem.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        RKTxt = Trim(lstContracts.SelectedItem.Text)
        Do While Not RsView1.EOF
        Set ItmX = ListView1.ListItems.Add(, , RsView1!流水号)
            ItmX.SubItems(1) = RsView1!部门名称
            ItmX.SubItems(2) = RsView1!类别名称
            ItmX.SubItems(3) = RsView1!物资编号
            ItmX.SubItems(4) = RsView1!单价
            ItmX.SubItems(5) = RsView1!数量
            ItmX.SubItems(6) = RsView1!金额
            ItmX.SubItems(7) = RsView1!业务员
            ItmX.SubItems(9) = RsView1!出库时间
            ItmX.SubItems(10) = RsView1!仓库名称
        If RsView1!审核状态 = "0" Then
            ItmX.SubItems(8) = " №"
        ElseIf RsView1!审核状态 = "1" Then
            ItmX.SubItems(8) = " √"
        ElseIf RsView1!审核状态 = "2" Then
            ItmX.SubItems(8) = " X"
        End If
        If RsView1!票据状态 = "0" Then
            ItmX.SubItems(11) = " №"
        ElseIf RsView1!票据状态 = "1" Then
            ItmX.SubItems(11) = " √"
        ElseIf RsView1!票据状态 = "2" Then
            ItmX.SubItems(11) = " X"
        ElseIf RsView1!票据状态 = "3" Then
            ItmX.SubItems(11) = " ?"
        End If
            ItmX.SubItems(12) = RsView1!备注
            RsView1.MoveNext
        Loop
        If Not RsView1.EOF Then RsView1.MoveFirst
            ListView1.Refresh
        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 Command1_Click()
    If Option1.Value = True Then
        PJZT = 0
    ElseIf Option2.Value = True Then
        PJZT = 1
    ElseIf Option3.Value = True Then
        PJZT = 2
    End If
    If Trim(RichTextBox1.Text) = "" Then
        MsgBox "请填写更改理由！", vbCritical, "错误"
        Exit Sub
    End If
    If MsgBox("确认要修改票据状态么？  票据编号：" & Trim(LblMaster.Caption), vbQuestion + vbYesNo) = vbYes Then
        Dim CmdExe As ADODB.Command
        Set CmdExe = New ADODB.Command
        CmdExe.ActiveConnection = Cw_DataEnvi.DataConnect
        CmdExe.CommandText = "update FL_辅料出库表 set 票据状态='" & PJZT & "' , 备注='" & RichTextBox1.Text & "' WHERE 流水号= '" & Trim(LblMaster.Caption) & "'"
        CmdExe.Execute
        RdoList
    End If
End Sub

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

Private Sub Form_Load()
    PrintFL = 2
    Dim RsRead As ADODB.Recordset
    Dim ItmX As ListItem
    lstContracts.ColumnHeaders.Clear
    lstContracts.ColumnHeaders.Add , , "票据编号", Len("票据编号") * 100 + 600
    lstContracts.ColumnHeaders.Add , , "打印", Len("打印") * 100 + 350
    lstContracts.ColumnHeaders.Add , , " 出库时间", Len("出库时间") * 100 + 700

        Set RsRead = New ADODB.Recordset
        RsRead.Open "SELECT Distinct 票据编号,出库时间,打印状态  FROM FL_辅料出库表 order by 出库时间 desc ", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        If Not RsRead.BOF Then RsRead.MoveFirst
        lstContracts.ListItems.Clear
        Do While Not RsRead.EOF
            Set ItmX = lstContracts.ListItems.Add(, , RsRead!票据编号)
             ItmX.SubItems(2) = RsRead!出库时间
            If RsRead!打印状态 = "0" Then
                ItmX.SubItems(1) = " №"
            ElseIf RsRead!打印状态 = "1" Then
                ItmX.SubItems(1) = " √"
            End If
             RsRead.MoveNext
        Loop
        If Not RsRead.EOF Then RsRead.MoveFirst
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 ListView1_DblClick()
    If Not ListView1.ListItems.Count < 1 Then
    
    TxtSqlbj = "select * from Fl_物资信息表 where 物资编号= '" & Trim(ListView1.SelectedItem.ListSubItems.Item(3).Text) & "'"
    Set Rstmp = New ADODB.Recordset
    Rstmp.Open TxtSqlbj, Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly, adCmdText
    
    If Rstmp.BOF And Rstmp.EOF Then
        Text1(1).Text = ""
        Text1(2).Text = ""
        Text1(3).Text = ""
        Text1(4).Text = ""
        Text1(5).Text = ""
        Text1(6).Text = ""
    Else
        Text1(0).Text = Rstmp!物资编号
        Text1(1).Text = Rstmp!类别编码
        Text1(2).Text = Rstmp!物资名称
        Text1(3).Text = Rstmp!物资型号
        Text1(4).Text = Rstmp!计量单位
        Text1(5).Text = " " & Rstmp!备注信息
    End If
    Rstmp.Close
    Set Rstmp = Nothing
        LblMaster.Caption = Trim(ListView1.SelectedItem.Text)
        Lbl05.Caption = Trim(ListView1.SelectedItem.ListSubItems.Item(1).Text)
        Lbl01.Caption = Trim(ListView1.SelectedItem.ListSubItems.Item(4).Text)
        Lbl02.Caption = Trim(ListView1.SelectedItem.ListSubItems.Item(5).Text)
        Lbl03.Caption = Trim(ListView1.SelectedItem.ListSubItems.Item(6).Text)
        Lbl04.Caption = Trim(ListView1.SelectedItem.ListSubItems.Item(9).Text)
        If Trim(ListView1.SelectedItem.ListSubItems.Item(8).Text) = "№" Then

        ElseIf Trim(ListView1.SelectedItem.ListSubItems.Item(8).Text) = "√" Then

        ElseIf Trim(ListView1.SelectedItem.ListSubItems.Item(8).Text) = "X" Then
            MsgBox "主管审核作废，请联系财务科！", vbCritical, "请注意："
        End If
        If Trim(ListView1.SelectedItem.ListSubItems.Item(11).Text) = "№" Then
            Option1.Value = True
        ElseIf Trim(ListView1.SelectedItem.ListSubItems.Item(11).Text) = "√" Then
            Option2.Value = True
        ElseIf Trim(ListView1.SelectedItem.ListSubItems.Item(11).Text) = "X" Then
            Option3.Value = True
        Else
            Option1.Value = False
            Option2.Value = False
            Option3.Value = False
            Option1.Enabled = False
            Option2.Enabled = False
            MsgBox "财务未结算，请联系财务科！", vbCritical, "请注意："
        End If
        RichTextBox1.Text = Trim(ListView1.SelectedItem.ListSubItems.Item(12).Text)
    End If
End Sub

Private Sub lstContracts_DblClick()
    DoList
    If Not lstContracts.ListItems.Count < 1 Then
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM FL_辅料出库表 where 票据编号='" & Trim(lstContracts.SelectedItem.Text) & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        RKTxt = Trim(lstContracts.SelectedItem.Text)
        Do While Not RsView1.EOF
        Set ItmX = ListView1.ListItems.Add(, , RsView1!流水号)
            ItmX.SubItems(1) = RsView1!部门名称
            ItmX.SubItems(2) = RsView1!类别名称
            ItmX.SubItems(3) = RsView1!物资编号
            ItmX.SubItems(4) = RsView1!单价
            ItmX.SubItems(5) = RsView1!数量
            ItmX.SubItems(6) = RsView1!金额
            ItmX.SubItems(7) = RsView1!业务员
            ItmX.SubItems(9) = RsView1!出库时间
            ItmX.SubItems(10) = RsView1!仓库名称
        If RsView1!审核状态 = "0" Then
            ItmX.SubItems(8) = " №"
        ElseIf RsView1!审核状态 = "1" Then
            ItmX.SubItems(8) = " √"
        ElseIf RsView1!审核状态 = "2" Then
            ItmX.SubItems(8) = " X"
        End If
        If RsView1!票据状态 = "0" Then
            ItmX.SubItems(11) = " №"
        ElseIf RsView1!票据状态 = "1" Then
            ItmX.SubItems(11) = " √"
        ElseIf RsView1!票据状态 = "2" Then
            ItmX.SubItems(11) = " X"
        ElseIf RsView1!票据状态 = "3" Then
            ItmX.SubItems(11) = " ?"
        End If
            ItmX.SubItems(12) = RsView1!备注
            RsView1.MoveNext
        Loop
        If Not RsView1.EOF Then RsView1.MoveFirst
        ListView1.Refresh
    AsPjbh = Trim(lstContracts.SelectedItem.Text)
    Aspjlx = "出库"
    Frm票据状态.Show 1
    End If

End Sub

Private Sub RKTxt_KeyDown(KeyCode As Integer, Shift As Integer)
    If KeyCode = 13 Then
        DoList
        DoList1
    End If
End Sub

Private Sub RKTxt_KeyPress(KeyAscii As Integer)
    If Not IsNumeric(Chr(KeyAscii)) Then
       KeyAscii = 0
    End If
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
            PrintTest2
    Case FORM_ADDED   ' 2
        ' Form added and selected.
        Form_Load     ' by rebuilding the list.
End Select
End Sub

Private Sub DoList1()
        Set RsView1 = New ADODB.Recordset
        RsView1.Open "SELECT *  FROM FL_辅料出库表 where 票据编号='" & RKTxt.Text & "'", Cw_DataEnvi.DataConnect, adOpenStatic, adLockReadOnly
        RKTxt = RKTxt.Text
        Do While Not RsView1.EOF
        Set ItmX = ListView1.ListItems.Add(, , RsView1!流水号)
            ItmX.SubItems(1) = RsView1!部门名称
            ItmX.SubItems(2) = RsView1!类别名称
            ItmX.SubItems(3) = RsView1!物资编号
            ItmX.SubItems(4) = RsView1!单价
            ItmX.SubItems(5) = RsView1!数量
            ItmX.SubItems(6) = RsView1!金额
            ItmX.SubItems(7) = RsView1!业务员
            ItmX.SubItems(9) = RsView1!出库时间
            ItmX.SubItems(10) = RsView1!仓库名称
        If RsView1!审核状态 = "0" Then
            ItmX.SubItems(8) = " №"
        ElseIf RsView1!审核状态 = "1" Then
            ItmX.SubItems(8) = " √"
        ElseIf RsView1!审核状态 = "2" Then
            ItmX.SubItems(8) = " X"
        End If
        If RsView1!票据状态 = "0" Then
            ItmX.SubItems(11) = " №"
        ElseIf RsView1!票据状态 = "1" Then
            ItmX.SubItems(11) = " √"
        ElseIf RsView1!票据状态 = "2" Then
            ItmX.SubItems(11) = " X"
        ElseIf RsView1!票据状态 = "3" Then
            ItmX.SubItems(11) = " ?"
        End If
            ItmX.SubItems(12) = RsView1!备注
            RsView1.MoveNext
        Loop
        If Not RsView1.EOF Then RsView1.MoveFirst
        ListView1.Refresh
    AsPjbh = RKTxt.Text
    Aspjlx = "出库"
    Frm票据状态.Show 1
End Sub