hcconst.bas

财务信息管理系统,适合做毕业论文的人使用

    
End Function

Public Function CharNumInStr(str1 As String, str2 As String) As Integer
    
    Dim i
    Dim lenth
    Dim num
    
    lenth = Len(str1)
    For i = 1 To lenth
        If mID(str1, i, 1) = str2 Then
            num = num + 1
        End If
    Next i
    CharNumInStr = num
    
End Function

'Public Sub InckChnEngForm(frm As Form)
'
'    Dim ctl As Control
'    frm.Icon = LoadResPicture(109, vbResIcon)
'    frm.Caption = GetResource(CInt(frm.Caption))
'    For Each ctl In frm.Controls
'        Select Case TypeName(ctl)
'            Case "Label", "OptionButton", "Frame", "UsedFlag"
'                If ctl.Tag <> "" Then
'                    ctl.Caption = GetResource(CInt(ctl.Tag))
'                End If
'        End Select
'    Next
'
'End Sub
'窗体中英文

Public Function AccCodeToDqBillID(AccCode As String) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
'    Set rsl = dbsZJ.OpenRecordset("FD_Sav", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cSavID From FD_Sav Where cAccID = '" & AccCode & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cAccID = '" & AccCode & "'"             'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                           'CuiDong Efficiency-A 2000/06/19 效率优化A
            AccCodeToDqBillID = !cSavID
        Else
            AccCodeToDqBillID = ""
        End If
    End With
    
    CloseRS rsl                                              'CuiDong Efficiency-A 2000/06/20 效率优化A
End Function
'由科目编码求名称
Public Function KmCodeToName(code As String) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
'    Set rsl = dbsZJ.OpenRecordset("code", dbOpenDynaset)      'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select ccode_name From Code Where ccode = '" & code & "'", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "ccode = '" & Code & "'"                   'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                  'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                             'CuiDong Efficiency-A 2000/06/19 效率优化A
            KmCodeToName = !ccode_name
        Else
            KmCodeToName = ""
        End If
    End With
    CloseRS rsl
End Function
'由科目名称求编码
Public Function KmNameToCode(code As String) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
'    Set rsl = dbsZJ.OpenRecordset("code", dbOpenDynaset)        'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cCode From Code Where ccode_name = '" & code & "'", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "ccode_name = '" & Code & "'"                'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                    'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                               'CuiDong Efficiency-A 2000/06/19 效率优化A
            KmNameToCode = !cCode
        Else
            KmNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function
'由个人编码求名称
Public Function PersonCodeToName(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        PersonCodeToName = ""
        Exit Function
    End If

'    Set rsl = dbsZJ.OpenRecordset("Person", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cPersonName From Person Where cPersonCode = '" & code & "'", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cPersonCode = '" & Code & "'"           'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                           'CuiDong Efficiency-A 2000/06/19 效率优化A
            PersonCodeToName = !cPersonName
        Else
            PersonCodeToName = ""
        End If
    End With
    CloseRS rsl
End Function
'由个人名称求编码
Public Function PersonNameToCode(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        PersonNameToCode = ""
        Exit Function
    End If
    
'    Set rsl = dbsZJ.OpenRecordset("Person", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cPersonCode From Person Where cPersonName = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cPersonName = '" & Code & "'"           'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                           'CuiDong Efficiency-A 2000/06/19 效率优化A
            PersonNameToCode = !cPersonCode
        Else
            PersonNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function DeptCodeToName(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        DeptCodeToName = ""
        Exit Function
    End If
    
'    Set rsl = dbsZJ.OpenRecordset("Department", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cDepName From Department Where cDepCode = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cDepCode = '" & Code & "'"                  'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                    'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                               'CuiDong Efficiency-A 2000/06/19 效率优化A
            DeptCodeToName = !cDepName
        Else
            DeptCodeToName = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function DeptNameToCode(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        DeptNameToCode = ""
        Exit Function
    End If
    
'    Set rsl = dbsZJ.OpenRecordset("Department", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cDepCode From Department Where cDepName = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cDepName = '" & Code & "'"                  'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                    'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                               'CuiDong Efficiency-A 2000/06/19 效率优化A
            DeptNameToCode = !cDepCode
        Else
            DeptNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function CusCodeToName(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        CusCodeToName = ""
        Exit Function
    End If
'    Set rsl = dbsZJ.OpenRecordset("Customer", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cCusAbbName From Customer Where cCusCode = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cCusCode = '" & Code & "'"                'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                  'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                             'CuiDong Efficiency-A 2000/06/19 效率优化A
            CusCodeToName = !cCusAbbName
        Else
            CusCodeToName = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function CusNameToCode(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        CusNameToCode = ""
        Exit Function
    End If
'    Set rsl = dbsZJ.OpenRecordset("Customer", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cCusCode From Customer Where cCusAbbName = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cCusAbbName = '" & Code & "'"             'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                  'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                             'CuiDong Efficiency-A 2000/06/19 效率优化A
            CusNameToCode = !cCusCode
        Else
            CusNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function SupCodeToName(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        SupCodeToName = ""
        Exit Function
    End If

'    Set rsl = dbsZJ.OpenRecordset("Vendor", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cVenAbbName From Vendor Where cVenCode = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cVenCode = '" & Code & "'"              'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                           'CuiDong Efficiency-A 2000/06/19 效率优化A
            SupCodeToName = !cVenAbbName
        Else
            SupCodeToName = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function SupNameToCode(code As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    
    Dim rsl As New UfRecordset
    
    If IsNull(code) Then
        SupNameToCode = ""
        Exit Function
    End If
'    Set rsl = dbsZJ.OpenRecordset("Vendor", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cVenCode From Vendor Where cVenAbbName = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cVenAbbName = '" & Code & "'"           'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                           'CuiDong Efficiency-A 2000/06/19 效率优化A
            SupNameToCode = !cVenCode
        Else
            SupNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function

Public Function ItemCodeToName(code As Variant, xmdl As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    
    Dim rsl As New UfRecordset
    If IsNull(code) Or IsNull(xmdl) Then
        ItemCodeToName = ""
        Exit Function
    End If
    If code = "" Or xmdl = "" Then
        ItemCodeToName = ""
        Exit Function
    End If
    '------------------- zcl - cuidong 2001.01.09
''    Set rsl = dbsZJ.OpenRecordset("fitemss" & xmdl, dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
'    Set rsl = dbsZJ.OpenRecordset("Select cItemName From fitemss" & xmdl & " Where citemcode = '" & Code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
'    With rsl
''        .FindFirst "citemcode = '" & Code & "'"                     'CuiDong Efficiency-A 2000/06/19 效率优化A
''        If Not .NoMatch Then                                        'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not (.EOF Or .BOF) Then                                   'CuiDong Efficiency-A 2000/06/19 效率优化A
'            ItemCodeToName = !cItemName
'        Else
'            ItemCodeToName = ""
'        End If
'    End With
'    CloseRS rsl
    
    '------------------- zcl - cuidong 2001.01.09
    If xmdl = "ch" Then
        Set rsl = dbsZJ.OpenRecordset("Select cInvName As sName From Inventory Where cInvCode ='" & code & "'")
    Else
        Set rsl = dbsZJ.OpenRecordset("Select cItemName As sName From fitemss" & xmdl & " Where citemcode = '" & code & "'")
    End If
    With rsl
        If Not (.EOF Or .BOF) Then
            ItemCodeToName = !sName
        Else
            ItemCodeToName = ""
        End If
    End With
    CloseRS rsl
    '------------------- zcl - cuidong 2001.01.09

End Function

Public Function ItemNameToCode(code As Variant, xmdl As Variant) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
    If IsNull(code) Then
        ItemNameToCode = ""
        Exit Function
    End If
    If xmdl = "" Then
        ItemNameToCode = ""
        Exit Function
    End If
      
'    Set rsl = dbsZJ.OpenRecordset("fitemss" & xmdl, dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select citemcode From fitemss" & xmdl & " Where citemname = '" & code & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "citemname = '" & Code & "'"                     'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If Not .NoMatch Then                                        'CuiDong Efficiency-A 2000/06/19 效率优化A
        If Not (.EOF Or .BOF) Then                                   'CuiDong Efficiency-A 2000/06/19 效率优化A
            ItemNameToCode = !citemcode
        Else
            ItemNameToCode = ""
        End If
    End With
    CloseRS rsl
End Function

Public Sub LoadKmGrade()
    'CuiDong Efficiency-A 2000/06