⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄

📁 VB开发的ERP系统
💻
字号:
VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "mscomctl.ocx"
Begin VB.Form Query_BankPay_Frm 
   AutoRedraw      =   -1  'True
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "人员选择"
   ClientHeight    =   5310
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   3585
   Icon            =   "查询_银行代发.frx":0000
   LinkTopic       =   "Form1"
   LockControls    =   -1  'True
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   5310
   ScaleWidth      =   3585
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton Cmd_More 
      Caption         =   "条件(&M)"
      Height          =   300
      Left            =   45
      TabIndex        =   7
      Top             =   4965
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_Cancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      Height          =   300
      Left            =   2370
      TabIndex        =   6
      Top             =   4965
      Width           =   1120
   End
   Begin VB.CommandButton Cmd_OK 
      Caption         =   "确定(&O)"
      Height          =   300
      Left            =   1207
      TabIndex        =   5
      Top             =   4965
      Width           =   1120
   End
   Begin MSComctlLib.TreeView TV_Dept 
      Height          =   3165
      Left            =   75
      TabIndex        =   4
      Top             =   1695
      Width           =   3420
      _ExtentX        =   6033
      _ExtentY        =   5583
      _Version        =   393217
      HideSelection   =   0   'False
      Style           =   7
      Checkboxes      =   -1  'True
      Appearance      =   1
   End
   Begin VB.TextBox Txt_Dept 
      Height          =   315
      Left            =   855
      TabIndex        =   3
      Top             =   1275
      Width           =   2655
   End
   Begin MSComctlLib.ImageCombo ImgCmb_Sort 
      Height          =   315
      Left            =   855
      TabIndex        =   0
      Top             =   105
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   556
      _Version        =   393216
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Locked          =   -1  'True
   End
   Begin MSComctlLib.ImageCombo ImgCmb_Bank 
      Height          =   315
      Left            =   855
      TabIndex        =   1
      Top             =   495
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   556
      _Version        =   393216
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Locked          =   -1  'True
   End
   Begin MSComctlLib.ImageCombo ImgCmb_Period 
      Height          =   315
      Left            =   855
      TabIndex        =   2
      Top             =   885
      Width           =   2655
      _ExtentX        =   4683
      _ExtentY        =   556
      _Version        =   393216
      ForeColor       =   -2147483640
      BackColor       =   -2147483643
      Locked          =   -1  'True
   End
   Begin VB.Label Lab_Mark 
      AutoSize        =   -1  'True
      Caption         =   "部门:"
      Height          =   180
      Index           =   3
      Left            =   60
      TabIndex        =   11
      Top             =   1350
      Width           =   450
   End
   Begin VB.Label Lab_Mark 
      AutoSize        =   -1  'True
      Caption         =   "会计期间:"
      Height          =   180
      Index           =   2
      Left            =   60
      TabIndex        =   10
      Top             =   955
      Width           =   810
   End
   Begin VB.Label Lab_Mark 
      AutoSize        =   -1  'True
      Caption         =   "银行:"
      Height          =   180
      Index           =   1
      Left            =   60
      TabIndex        =   9
      Top             =   560
      Width           =   450
   End
   Begin VB.Label Lab_Mark 
      AutoSize        =   -1  'True
      Caption         =   "工资类别:"
      Height          =   180
      Index           =   0
      Left            =   60
      TabIndex        =   8
      Top             =   165
      Width           =   810
   End
End
Attribute VB_Name = "Query_BankPay_Frm"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'******************************************************************
'*    模 块 名 称 :银行代发查询条件
'*    功 能 描 述 :
'*    程序员姓名  :苗鹏
'*    最后修改人  :苗鹏
'*    最后修改时间:2002/01/10
'*    备        注:
'******************************************************************
Option Explicit
Dim sSqlWhere As String
Dim sSqlWhereMe As String
Dim sSqlWhereMore As String
Dim sSqlFrom As String
Dim coll As New Collection

Private Sub Cmd_Cancel_Click()
    Me.Hide
End Sub

Private Sub Cmd_More_Click() '调用公用查询窗体显示根多条件
    On Error GoTo ErrCtrl
    Dim frm As New Query_Frm
    With frm
        Set .collTableName = coll
        .Show 1
        If .bChecked = True Then
            sSqlWhereMore = .sSqlWhere
        End If
    End With
    Set frm = Nothing
    Exit Sub
ErrCtrl:
    Set frm = Nothing
End Sub

Private Sub Cmd_OK_Click() '获得条件
    On Error GoTo ErrCtrl
    
    Dim i As Integer
    Dim st As String
    Dim s As String
    Dim sSortID As String
    Dim sBankCode As String
    '需要查询的部门
    With Me.TV_Dept
        For i = 1 To .Nodes.Count
            If .Nodes(i).Checked = True And .Nodes(i).Children = 0 Then
                s = s & ",'" & Trim(.Nodes(i).Tag) & "'"
            End If
        Next i
    End With
    s = Trim(s)
    If s <> "" Then
        s = Mid(s, 2, Len(s) - 1)
         s = " PM_PayRoll.DeptCode in (" & s & ") " & Chr(10)
    End If
    
    '初始化sSqlWhereMe
    If s = "" Then
        sSqlWhereMe = " where PM_PayRoll.DeptCode in (select DeptCode from PM_OpeDept where Czybm='" & Xtczybm & "') " & Chr(10) _
            & " and Pm_PayRoll.SortID in (Select SortID from PM_OpeSort where Czybm='" & Xtczybm & "') " & Chr(10) _
            & " and PM_SortEmp.HaltFlag=0 " & Chr(10)
    Else
        sSqlWhereMe = " where PM_PayRoll.DeptCode in (select DeptCode from PM_OpeDept where Czybm='" & Xtczybm & "') " & Chr(10) _
        & " and Pm_PayRoll.SortID in (Select SortID from PM_OpeSort where Czybm='" & Xtczybm & "') " & Chr(10) _
        & " and PM_SortEmp.HaltFlag=0 " & Chr(10) _
        & " and " & s
    End If
    '工资类别
    st = sSqlWhereMe
    sSortID = GetComboKey(Me.ImgCmb_Sort, 0)
    If Trim(Me.ImgCmb_Sort.Text) <> "" Then
        st = st & " and PM_PayRoll.SortID='" & sSortID & "' " & Chr(10)
    Else
        MsgBox "请选择工资类别!", vbOKOnly + vbCritical
        Exit Sub
    End If
    '银行
    sBankCode = GetComboKey(Me.ImgCmb_Bank, 0)
    If Trim(Me.ImgCmb_Bank.Text) <> "" Then
        st = st & " and PM_SortEmp.BankCode='" & sBankCode & "' " & Chr(10)
    Else
        MsgBox "请选择银行!", vbOKOnly + vbCritical
        Exit Sub
    End If
    '会计期间
    If Trim(Me.ImgCmb_Period.Text) <> "" Then
       st = st & " and PM_PayRoll.KjYear=" & Xtyear & " and PM_PayRoll.Period=" & Me.ImgCmb_Period.Text & Chr(10)
    Else
        MsgBox "请选择会计期间!", vbOKOnly + vbCritical
        Exit Sub
    End If
    
    '其他条件
    If Trim(sSqlWhereMore) <> "" Then
        st = st & " and ( " & sSqlWhereMore & " ) "
    End If
    
    sSqlWhere = st
    
    '读取from语句
    s = Trim(GetSQLFrom(coll, "PM_PayRoll"))
    sSqlFrom = "from " & s & " inner join PM_SortEmp on PM_PayRoll.EmpID=PM_SortEmp.EmpID and PM_PayRoll.SortID=PM_SortEmp.SortID " & Chr(10)
    
    '查询数据
    Me.Hide
    With Rep_BankPay_Frm
        .sSqlFrom = sSqlFrom
        .sSqlWhere = sSqlWhere
        .sSortID = sSortID
        .sBankCode = sBankCode
        .sSortName = Me.ImgCmb_Sort.Text
        .sBankName = Me.ImgCmb_Bank.Text
        .iPeriod = Me.ImgCmb_Period.Text
        .ShowRecord .sSqlWhere, .sSqlFrom
    End With
    Exit Sub
ErrCtrl:
    Me.Hide
End Sub

Private Sub Form_Load()
    On Error GoTo ErrCtrl
    Dim i As Integer
    Dim s As String
    Dim rs As New ADODB.Recordset
    Dim nod As ComboItem
    '添加会计期间
    For i = 1 To 12
        Me.ImgCmb_Period.ComboItems.Add , , i
    Next i
    Me.ImgCmb_Bank.Locked = True
    s = " select top 1 Period from GY_Kjrlb  where PMjzbz=0 order by KjYear ,Period "
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        If Not .EOF() Then
            Me.ImgCmb_Period.Text = !Period
        Else
            MsgBox "系统没有初始化,请先初始化系统!", vbOKOnly + vbCritical
            rs.Close
            Set rs = Nothing
            Unload Me
            Exit Sub
        End If
        rs.Close
    End With
    '添加工资类别
    s = "select b.SortID,b.SortName from PM_OpeSort a inner join PM_Sort b on a.SortID=b.SortID where a.Czybm='" & Xtczybm & "'"
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        Do While Not .EOF()
            Set nod = Me.ImgCmb_Sort.ComboItems.Add(, "@" & Trim(!SortId), Trim(!SortName))
            nod.Tag = !SortId
            .MoveNext
        Loop
        .Close
    End With
    If Me.ImgCmb_Sort.ComboItems.Count <> 0 Then
        Me.ImgCmb_Sort.ComboItems.Item(1).Selected = True
    End If
    
    Set rs = Nothing
    Set nod = Nothing
    
    '添加银行
    FillImageCombo Me.ImgCmb_Bank, "Pm_Bank", 1
    '初始化部门树
    FillDept2TV "RsPmFlag", Me.TV_Dept, Cw_DataEnvi.DataConnect
    Exit Sub

ErrCtrl:
    If rs.State = 1 Then
        rs.Close
    End If
    Set rs = Nothing
    Set nod = Nothing
End Sub

Private Sub ImgCmb_Bank_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub ImgCmb_Period_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub ImgCmb_Sort_KeyPress(KeyAscii As Integer)
    If KeyAscii = 13 Then
        SendKeys "{Tab}"
    End If
End Sub

Private Sub TV_Dept_BeforeLabelEdit(Cancel As Integer)
    Cancel = 1
End Sub

Private Sub TV_Dept_NodeCheck(ByVal node As MSComctlLib.node) '保持子节点与父节点同步
    Dim i As Integer
    With Me.TV_Dept
        For i = 1 To .Nodes.Count
            If .Nodes(i).Parent Is node Then
                .Nodes(i).Checked = node.Checked
                Call TV_Dept_NodeCheck(.Nodes(i))
            End If
        Next i
    End With
End Sub

Private Sub Txt_Dept_Change() '根据录入内容选择打开的节点
    Dim i As Integer
    Dim s As String
    s = Trim(Me.Txt_Dept.Text)
    With Me.TV_Dept
        For i = 1 To .Nodes.Count
            If .Nodes(i).Tag = s Then
                .Nodes(i).EnsureVisible
                .SelectedItem = .Nodes(i)
                Exit Sub
            End If
        Next i
    End With
End Sub

Private Sub Txt_Dept_KeyPress(KeyAscii As Integer) '选择节点及子节点
    With Me.TV_Dept
        If KeyAscii = 13 Then
            If Not .SelectedItem Is Nothing Then
                .SelectedItem.Checked = Not .SelectedItem.Checked
                Call TV_Dept_NodeCheck(.SelectedItem)
            End If
        End If
    End With
End Sub

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -