frmac_affiliationselect.frm

一个用VB写的财务软件源码

VERSION 5.00
Begin VB.Form frmAC_AffiliationSelect 
   BorderStyle     =   3  'Fixed Dialog
   Caption         =   "关联交易统计表"
   ClientHeight    =   1965
   ClientLeft      =   45
   ClientTop       =   330
   ClientWidth     =   4725
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   MinButton       =   0   'False
   ScaleHeight     =   1965
   ScaleWidth      =   4725
   ShowInTaskbar   =   0   'False
   StartUpPosition =   1  '所有者中心
   Begin VB.CommandButton cmdCompany 
      Height          =   285
      Left            =   4380
      Picture         =   "frmAC_AffiliationSelect.frx":0000
      Style           =   1  'Graphical
      TabIndex        =   14
      Top             =   930
      Width           =   300
   End
   Begin VB.TextBox txtCompany 
      Enabled         =   0   'False
      Height          =   285
      Left            =   600
      TabIndex        =   13
      Top             =   930
      Width           =   3795
   End
   Begin VB.ComboBox cboMonthFrom 
      Height          =   300
      Left            =   600
      Style           =   2  'Dropdown List
      TabIndex        =   0
      Top             =   60
      Width           =   1785
   End
   Begin VB.ComboBox cboMonthTo 
      Height          =   300
      Left            =   2880
      Style           =   2  'Dropdown List
      TabIndex        =   1
      Top             =   60
      Width           =   1785
   End
   Begin VB.TextBox txtSubjectCodeFrom 
      Height          =   285
      Left            =   600
      MaxLength       =   18
      TabIndex        =   2
      Top             =   510
      Width           =   1485
   End
   Begin VB.CommandButton cmdSubjectHelpOne 
      Height          =   285
      Left            =   2085
      Picture         =   "frmAC_AffiliationSelect.frx":0102
      Style           =   1  'Graphical
      TabIndex        =   8
      Top             =   510
      Width           =   300
   End
   Begin VB.CommandButton cmdSubjectHelpTwo 
      Height          =   285
      Left            =   4365
      Picture         =   "frmAC_AffiliationSelect.frx":0204
      Style           =   1  'Graphical
      TabIndex        =   7
      Top             =   510
      Width           =   300
   End
   Begin VB.TextBox txtSubjectCodeTo 
      Height          =   285
      Left            =   2910
      MaxLength       =   18
      TabIndex        =   3
      Top             =   510
      Width           =   1485
   End
   Begin VB.CommandButton cmdHelp 
      Caption         =   "帮助(&H)"
      CausesValidation=   0   'False
      Height          =   345
      Left            =   3540
      TabIndex        =   6
      Top             =   1560
      Width           =   1065
   End
   Begin VB.CommandButton cmdCancel 
      Cancel          =   -1  'True
      Caption         =   "取消(&C)"
      CausesValidation=   0   'False
      Height          =   345
      Left            =   2400
      TabIndex        =   5
      Top             =   1560
      Width           =   1065
   End
   Begin VB.CommandButton cmdOk 
      Caption         =   "确认(&O)"
      Height          =   345
      Left            =   1230
      TabIndex        =   4
      Top             =   1560
      Width           =   1065
   End
   Begin VB.Label Label4 
      Caption         =   "单位："
      Height          =   285
      Left            =   60
      TabIndex        =   15
      Top             =   960
      Width           =   555
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "月份："
      Height          =   180
      Left            =   60
      TabIndex        =   12
      Top             =   120
      Width           =   540
   End
   Begin VB.Label Label3 
      AutoSize        =   -1  'True
      Caption         =   "科目："
      Height          =   180
      Left            =   60
      TabIndex        =   11
      Top             =   555
      Width           =   540
   End
   Begin VB.Line Line1 
      X1              =   0
      X2              =   4680
      Y1              =   1380
      Y2              =   1380
   End
   Begin VB.Line Line2 
      BorderColor     =   &H80000005&
      X1              =   30
      X2              =   4680
      Y1              =   1395
      Y2              =   1395
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "至"
      Height          =   180
      Left            =   2550
      TabIndex        =   10
      Top             =   120
      Width           =   180
   End
   Begin VB.Label Label9 
      AutoSize        =   -1  'True
      Caption         =   "至"
      Height          =   180
      Left            =   2550
      TabIndex        =   9
      Top             =   555
      Width           =   180
   End
End
Attribute VB_Name = "frmAC_AffiliationSelect"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit

Public Ok As Boolean

Private m_sMonthFrom As String, m_sMonthTo As String                        '查询起始月份、截止月份
            
Private m_sSubjectCodeFrom As String, m_sSubjectNameFrom As String          '查询起始科目代码、科目名称
Private m_sSubjectCodeTo As String, m_sSubjectNameTo As String              '查询截止科目代码、科目名称
Private m_sCompany As String

Public Property Get usMonthFrom() As String
    usMonthFrom = m_sMonthFrom
End Property

Public Property Get usMonthTo() As String
    usMonthTo = m_sMonthTo
End Property

Public Property Get usSubjectCodeFrom() As String
    usSubjectCodeFrom = m_sSubjectCodeFrom
End Property

Public Property Get usSubjectNameFrom() As String
    usSubjectNameFrom = m_sSubjectNameFrom
End Property

Public Property Get usSubjectCodeTo() As String
    usSubjectCodeTo = m_sSubjectCodeTo
End Property

Public Property Get usSubjectNameTo() As String
    usSubjectNameTo = m_sSubjectNameTo
End Property

Public Property Get usCompany() As String
    usCompany = m_sCompany
End Property

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


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

Private Sub cmdCancel_Click()
    Ok = False
    Me.Hide
End Sub

Private Sub cmdCompany_Click()
    frmUSU_HelpCompany.Show 1, Me
    If frmUSU_HelpCompany.Ok Then
        txtCompany.text = frmUSU_HelpCompany.usCode
    End If
    Unload frmUSU_HelpCompany
End Sub

Private Sub cmdOk_Click()
    If SqlStringValid(txtSubjectCodeFrom) = False Then
         MsgBox "起始科目中含有非法字符！"
         Exit Sub
    End If
    If SqlStringValid(txtSubjectCodeTo) = False Then
         MsgBox "结束科目中含有非法字符！"
         Exit Sub
    End If
    m_sMonthFrom = Mid(cboMonthFrom.text, InStr(1, cboMonthFrom.text, ".") + 1)
    m_sMonthTo = Mid(cboMonthTo.text, InStr(1, cboMonthTo.text, ".") + 1)
    
    m_sSubjectCodeFrom = ""
    m_sSubjectNameFrom = ""
    If Trim$("" & txtSubjectCodeFrom.text) <> "" Then
        If Valid(txtSubjectCodeFrom.text, m_sSubjectCodeFrom, m_sSubjectNameFrom) = False Then
            MsgBox "科目输入不正确！", vbInformation
            txtSubjectCodeFrom.SetFocus
            Exit Sub
        End If
    End If
    
    m_sSubjectCodeTo = ""
    m_sSubjectNameTo = ""
    If Trim$("" & txtSubjectCodeTo.text) <> "" Then
        If Valid(txtSubjectCodeTo.text, m_sSubjectCodeTo, m_sSubjectNameTo) = False Then
            MsgBox "科目输入不正确！", vbInformation
            txtSubjectCodeTo.SetFocus
            Exit Sub
        End If
    End If
    
    m_sCompany = txtCompany.text
     Ok = True
     Me.Hide
End Sub

Private Function Valid(ByVal s As String, ByRef Code As String, ByRef Name As String) As Boolean
    s = Trim$(s)
    Dim sCode As String
    Dim sName As String
    Dim iPos As Integer
    iPos = InStr(1, s, "=")
    If iPos > 0 Then
        sCode = Mid$(s, 1, iPos - 1)
        sName = Mid$(s, iPos + 1)
    Else
        sCode = s
        sName = s
    End If
    Dim rSt As New ADODB.Recordset
    rSt.Open "Select Code,Name from tMR_BillParameter where Code='" + sCode + "' or Name='" + sName + "'", glo.cnnMain, adOpenKeyset, adLockOptimistic
    If rSt.EOF = False Then
        Code = rSt.Fields(0).value
        Name = rSt.Fields(1).value
        Valid = True
    Else
        Valid = False
    End If
    rSt.Close
End Function

Private Sub cmdSubjectHelpOne_Click()
    frmUSU_HelpBillParameter.Show 1, Me
    If frmUSU_HelpBillParameter.Ok Then
        txtSubjectCodeFrom.text = frmUSU_HelpBillParameter.usCode + "=" + frmUSU_HelpBillParameter.usName
    End If
    Unload frmUSU_HelpBillParameter
End Sub

Private Sub cmdSubjectHelpTwo_Click()
    frmUSU_HelpBillParameter.Show 1, Me
    If frmUSU_HelpBillParameter.Ok Then
        txtSubjectCodeTo.text = frmUSU_HelpBillParameter.usCode + "=" + frmUSU_HelpBillParameter.usName
    End If
    Unload frmUSU_HelpBillParameter
End Sub


Private Sub form_load()
    Dim rstTemp As ADODB.Recordset
    Dim sSQL As String
    Dim i As Integer
    Dim m_iMinStartMonth As Integer
    Dim m_iMaxEndMonth As Integer
    
    Set rstTemp = New ADODB.Recordset
    rstTemp.CursorLocation = adUseClient
    
    '求出最小开始月份
    sSQL = "SELECT * FROM tSYS_SubSysUsed WHERE AccountID = '" & glo.sAccountID & _
            "' AND SubSysID = '" & gloSys.sSubSysID & "'"
    rstTemp.Open sSQL, gloSys.cnnSYS, adOpenStatic, adLockReadOnly
    With rstTemp
        If .RecordCount > 0 Then
            '如果当前注册年份大于结账年, 则查询最小月份为一月份、最大月份为一月份；
            If Val(glo.sOperateYear) > Val(.Fields("ModiYear").value) Then
                m_iMinStartMonth = 0
'                m_iMaxEndMonth = 1
            '否则如果注册年份等于结账年份, 则查询最小月份为
                                            '(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于结账月+1
            ElseIf Val(glo.sOperateYear) = Val(.Fields("ModiYear").value) Then
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), _
                                    .Fields("BeginMonth").value - 1, 0)
'                m_iMaxEndMonth = .Fields("ModiMonth").Value + 1
            '否则查询最小月份为(如果注册年份等于
                                            '(如果注册年份等于子系统启用年份, 则等于子系统启用月份;
                                            '否则等于一月份);
                                            '最大月份等于12
            Else
                m_iMinStartMonth = IIf(Val(glo.sOperateYear) = Val(.Fields("BeginYear").value), _
                                    .Fields("BeginMonth").value - 1, 0)
            End If
        End If
        .Close
    End With
    '最大结束月份为12
    m_iMaxEndMonth = 12
    
   
    '查询起始月从子系统启用月份到12月份
    For i = m_iMinStartMonth + 1 To 12
        cboMonthFrom.AddItem glo.sOperateYear & "." & i
    Next i
    
    '查询截止月从子系统启用月份到12月份
    For i = m_iMinStartMonth + 1 To 12
        cboMonthTo.AddItem glo.sOperateYear & "." & i
    Next i
    
    '选中的查询起始月等于当前注册月
    cboMonthFrom.ListIndex = Month(glo.sOperateDate) - m_iMinStartMonth - 1
    cboMonthTo.ListIndex = cboMonthFrom.ListIndex
    
    '''
    '删除多余的交易
    Dim iKjqj As String
    Dim sBZ As String
    Dim rSt As New Recordset
    sSQL = "select a.kjqj,a.bz,b.bz from Tmr_Offsetbill a,(Select kjqj,pzzl||pzbh bz from Tzw_Pzsj" + glo.sOperateYear + ") b where  a.kjqj= b.kjqj(+) and  a.bz=b.bz(+)"
    
    glo.cnnMain.BeginTrans
    rSt.Open sSQL, glo.cnnMain, adOpenKeyset, adLockOptimistic
    While rSt.EOF = False
        If IsNull(rSt.Fields(2).value) Then
            iKjqj = CStr(FormatToDouble(rSt.Fields(0).value))
            sBZ = Trim(CStr(FormatToString(rSt.Fields(1).value)))
            glo.cnnMain.Execute "delete from tMR_OffsetBill where kjnf='" + glo.sOperateYear + "' and kjqj=" + iKjqj + " and ID='9999' and BZ='" + sBZ + "'"
        End If
        rSt.MoveNext
    Wend
    rSt.Close
    glo.cnnMain.CommitTrans
End Sub

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

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