hcconst.bas

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

Err_BillSaveUnLock:
End Function

'cuidong 2001.08.29
'得到Gird某一完整列的数据总和
Public Function GetColumnSum(oGrid As Object, ByVal iColumn As Long, Optional ByVal iDecimalDigits As Long = 2, Optional ByVal bReturn0 As Boolean = False) As String
    
'    Dim i As Long
'    Dim nSum As Double
'
'    On Error GoTo Exit_GetColumnSum
'
'    With oGrid
'        nSum = 0
'        For i = IIf(.FixedRows > 0, .FixedRows - 1, 0) To .Rows - .FixedRows - 1
'            nSum = nSum + Val(.TextMatrix(i, iColumn))
'        Next i
'    End With
'
'    If nSum = 0 Then
'       If Not bReturn0 Then
'          GetColumnSum = vbNullString
'       End If
'    End If
'
'    GetColumnSum = Format(nSum, "0" & IIf(iDecimalDigits <= 0, vbNullString, , String$(iDecimalDigits, "0")))
'
'Exit_GetColumnSum:
End Function





'cuidong 2001.08.23
'将ComboBox中的项目移到与sText相同内容的项目上。
Public Function MoveComboByText(oComboBox As Object, ByVal sText As String) As Boolean
    Dim i As Long
    
    MoveComboByText = False
    On Error GoTo Err_MoveComboByText
    
    sText = UCase(Trim(sText))
    
    With oComboBox
        For i = 0 To .ListCount - 1
            If sText = UCase(Trim(.List(i))) Then
               .ListIndex = i
               MoveComboByText = True
               GoTo Err_MoveComboByText
            End If
        Next i
        .AddItem sText
        .ListIndex = .NewIndex
    End With
    
Err_MoveComboByText:
End Function

'获取上一结息日
Public Function PreviousClosDay(CadCode As String, CurDay As Date) As Variant

    Dim sql As String
    Dim rsl As New UfRecordset
    
'    sql = "SELECT Max([dClosDate]) AS ClosDay " & _
          "From FD_CadSets " & _
          "WHERE FD_CadSets.cCadID='" & CadCode & "' AND FD_CadSets.dClosDate<#" & Format(CurDay, "yyyy-mm-dd") & "#" 'CuiDong Efficiency-B 2000/06/21 效率优化B
    sql = "SELECT Max([dClosDate]) AS ClosDay " & _
          "From FD_CadSets " & _
          "WHERE FD_CadSets.cCadID='" & CadCode & "' AND FD_CadSets.dClosDate<'" & Format(CurDay, "yyyy-mm-dd") & "'" 'CuiDong Efficiency-B 2000/06/21 效率优化B
    Set rsl = dbsZJ.OpenRecordset(sql, dbOpenSnapshot)
    With rsl
        If Not (.EOF Or .BOF) Then             'CuiDong Efficiency-B 2000/06/21 效率优化B
           If Not IsNull(!ClosDay) Then
               PreviousClosDay = !ClosDay
           Else
               PreviousClosDay = Null
           End If
        Else                                   'CuiDong Efficiency-B 2000/06/21 效率优化B
           PreviousClosDay = Null              'CuiDong Efficiency-B 2000/06/21 效率优化B
        End If                                 'CuiDong Efficiency-B 2000/06/21 效率优化B
    End With
    CloseRS rsl
    
End Function
'基础设置窗体及空间调整
Public Sub ResizeForm(frm As Form, obj2 As Object, obj3 As Object, _
                      obj4 As Object, Frm_W As Single, Frm_H As Single)
                  
Dim offset_x As Single, offset_y As Single
Dim TmpW As Single

  If frm.Tag <> "opened" Then
    If frm.WindowState = vbNormal Then
      'frm.Width = Frm_W
      'frm.Height = Frm_H
      frm.Tag = "opened"
      Exit Sub
    End If
  End If
      
  If frm.WindowState = vbMinimized Then Exit Sub
      
  Frm_W = frm.width
  Frm_H = frm.Height
  
  offset_x = 120
    
  offset_y = 390
  If frm.Caption = "账户科目" Then
    If Frm_W - obj2.left - offset_x > 0 Then
      obj2.width = Frm_W - obj2.left - offset_x
    End If
    If Frm_H - obj2.top - offset_y > 0 Then
      obj2.Height = Frm_H - obj2.top - offset_y
    End If
  Else
    If Frm_H - obj2.top - offset_y > 0 Then
      obj2.Height = Frm_H - obj2.top - offset_y
    End If
    If Frm_W - obj3.left - offset_x > 0 Then
      obj3.width = Frm_W - obj3.left - offset_x
    End If
    obj3.Height = obj2.Height
    obj4.Height = obj2.Height
  End If
  
  frm.Tag = "opened"
  
End Sub
'由开户单位名称求开户编码
Public Function EntNameToCode(EntName As String, Optional bfind As Boolean) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
'    Set rsl = dbsZJ.OpenRecordset("FD_AccUnit", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cUnitCode From FD_AccUnit Where cUnitName = '" & EntName & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
'    rsl.FindFirst "cUnitName = '" & EntName & "'"               'CuiDong Efficiency-A 2000/06/19 效率优化A
'    If Not rsl.NoMatch Then                                     'CuiDong Efficiency-A 2000/06/19 效率优化A
    If Not (rsl.EOF Or rsl.BOF) Then                             'CuiDong Efficiency-A 2000/06/19 效率优化A
        EntNameToCode = rsl!cUnitCode
        bfind = True
    Else
        EntNameToCode = ""
        bfind = False
    End If
    rsl.oClose
End Function
'由开户单位编码求开户名称
Public Function EntCodeToName(EntCode As String, Optional bfind As Boolean) As String
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
'    Set rsl = dbsZJ.OpenRecordset("FD_AccUnit", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select cUnitName From FD_AccUnit Where cUnitCode = '" & EntCode & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
'    rsl.FindFirst "cUnitCode = '" & EntCode & "'"               'CuiDong Efficiency-A 2000/06/19 效率优化A
'    If Not rsl.NoMatch Then                                     'CuiDong Efficiency-A 2000/06/19 效率优化A
    If Not (rsl.EOF Or rsl.BOF) Then                             'CuiDong Efficiency-A 2000/06/19 效率优化A
        EntCodeToName = rsl!cunitName
        bfind = True
    Else
        EntCodeToName = EntCode
        bfind = False
    End If
    rsl.oClose
End Function
'右键菜单
Public Sub RightMenu(frm As Object, but As Integer, Mnu As Object, obj As Object, x As Single, y As Single)

  Select Case but
      Case 2
          frm.PopupMenu Mnu, , obj.left + x, obj.top + y
  End Select

End Sub

Public Function FindNode(trv As Object, fsk As Boolean, nodstr1 As String, Optional nodstr2 As Variant) As Boolean

Dim nodx As Node
Dim b2 As Boolean

  If IsMissing(nodstr2) Then
    b2 = False
  Else
    b2 = True
  End If
  
  FindNode = False
  
  If b2 Then
    For Each nodx In trv.Nodes
      If Not nodx.Parent Is Nothing Then
        If nodx.Text = nodstr2 And nodx.Parent = nodstr1 Then
          nodx.Selected = True
          nodx.EnsureVisible
          If fsk Then
            trv.SetFocus
          End If
          FindNode = True
          Exit For
        End If
      End If
    Next
  Else
    For Each nodx In trv.Nodes
      If nodx.Text = nodstr1 Then
        nodx.Selected = True
        nodx.EnsureVisible
        If fsk Then
            trv.SetFocus
        End If
        FindNode = True
        Exit For
      End If
    Next
  End If
    
End Function

Public Function FindDupNode(trv As Object, selnode As Object, keystr As String) As Boolean

Dim b2 As Boolean
Dim nodx As Node

  If selnode.Parent Is Nothing Then
    b2 = False
  Else
    b2 = True
  End If
  
  FindDupNode = False
  
  For Each nodx In trv.Nodes
    If b2 Then
      If Not nodx.Parent Is Nothing Then
        If nodx.Parent = selnode.Parent And nodx = keystr And nodx.index <> selnode.index Then
          FindDupNode = True
          Exit Function
        End If
      End If
    Else
      If nodx = keystr And nodx.index <> selnode.index Then
        FindDupNode = True
        Exit Function
      End If
    End If
  Next
  
End Function
'由账户编码求开户单位名称
Public Function AccCodeToUnitName(AccCode As String, Optional bfind As Boolean) As String
  'CuiDong Efficiency-A 2000/06/19 效率优化A OK
  Dim rsl As New UfRecordset

  If AccCode = "" Then
    bfind = False
    AccCodeToUnitName = ""
    Exit Function
  End If
  
'  Set rsl = dbsZJ.OpenRecordset("FD_AccDef", dbOpenDynaset)  'CuiDong Efficiency-A 2000/06/19 效率优化A
  Set rsl = dbsZJ.OpenRecordset("Select cUnitCode From FD_AccDef Where cAccID = '" & AccCode & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
'  rsl.FindFirst "cAccID = '" & AccCode & "'"                 'CuiDong Efficiency-A 2000/06/19 效率优化A
  
'  If rsl.NoMatch Then                                        'CuiDong Efficiency-A 2000/06/19 效率优化A
  If rsl.EOF Or rsl.BOF Then                                  'CuiDong Efficiency-A 2000/06/19 效率优化A
    bfind = False
    AccCodeToUnitName = ""
    Exit Function
  End If
  
  AccCodeToUnitName = EntCodeToName(rsl!cUnitCode)
  bfind = True
  
  Set rsl = Nothing
  
End Function
'利息计算窗体及控件位置调整
Public Sub ResizeFrmLxjs(frm As Form, obj1 As Object, obj2 As Object, obj3 As Object, _
                       Frm_W As Single, Frm_H As Single)
                  
Dim offset_x As Single, offset_y As Single
Dim TmpW As Single

  If frm.Tag <> "opened" Then
    If frm.WindowState = vbNormal Then
      frm.width = Frm_W
      frm.Height = Frm_H
      frm.Tag = "opened"
      Exit Sub
    End If
  End If
      
  If frm.WindowState = vbMinimized Then Exit Sub
      
  Frm_W = frm.width
  Frm_H = frm.Height
  
  offset_x = 120
  If Frm_W - obj3.left - offset_x > 0 Then
    obj3.width = Frm_W - obj3.left - offset_x
    obj2.width = obj3.width
  End If
      
  offset_y = 390
  If Frm_H - obj3.top - offset_y > 0 Then
    obj3.Height = Frm_H - obj3.top - offset_y
  End If
    
  frm.Tag = "opened"
  
End Sub
'求账户属性
Public Function AccProperty(AccCode As String) As AccountProperty
    'CuiDong Efficiency-A 2000/06/19 效率优化A OK
    Dim rsl As New UfRecordset
  
'    Set rsl = dbsZJ.OpenRecordset("FD_AccDef", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    Set rsl = dbsZJ.OpenRecordset("Select * From FD_AccDef Where cAccID = '" & AccCode & "'", dbOpenDynaset) 'CuiDong Efficiency-A 2000/06/19 效率优化A
    With rsl
'        .FindFirst "cAccID = '" & AccCode & "'"               'CuiDong Efficiency-A 2000/06/19 效率优化A
'        If .NoMatch Then                                      'CuiDong Efficiency-A 2000/06/19 效率优化A
        If .EOF Or .BOF Then                                   'CuiDong Efficiency-A 2000/06/19 效率优化A
            AccProperty.bfind = False
            GoTo CloseRecordset
        End If
        AccProperty.bfind = True
        AccProperty.AccCode = !cAccId
        AccProperty.AccName = !cAccName
        AccProperty.iio = !iio
        AccProperty.ipc = !iType
        AccProperty.isrc = !iDataSrc
        AccProperty.UnitCode = !cUnitCode
        AccProperty.IntrID = !cintrid
        AccProperty.CadID = IIf(IsNull(!cCadID), "", !cCadID)
        AccProperty.cYtID = IIf(IsNull(!cYtID), "", !cYtID)
        AccProperty.iYt = IIf(IsNull(!iYt), 0, !iYt)
        AccProperty.CurrencyName = !cexch_name
        GoTo CloseRecordset
    End With
    
ExitSub:
    Exit Function
CloseRecordset:
    rsl.oClose
    Set rsl = Nothing
    GoTo ExitSub
    
End Function

'判断单位名称是否存在
Public Function IsUnitNameExist(UnitName As String) As Boolean