frmselectedzxt.frm

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

            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "GZ"
            lstItem.SubItems(1) = "工资核算"
            lstItem.SubItems(2) = "Pay"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='GZ' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "BB"
            lstItem.SubItems(1) = "财务报表"
            lstItem.SubItems(2) = "FinanceReport"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='BB' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "FX"
            lstItem.SubItems(1) = "财务分析"
            lstItem.SubItems(2) = "FinanceAnalysis"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='FX' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                       rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "CF"
            lstItem.SubItems(1) = "现金流量"
            lstItem.SubItems(2) = "CashFlow"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='CF' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "MR"
            lstItem.SubItems(1) = "合并报表"
            lstItem.SubItems(2) = "MergeReport"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='MR' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "FZ"
            Dim sId As String, b As Boolean
            b = CheckLicence(sId)
            If sId = "01" Then
               lstItem.SubItems(1) = "项目管理"
            Else
               lstItem.SubItems(1) = "辅助管理"
            End If
            lstItem.SubItems(2) = "AssistantManage"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='FZ' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "SF"
            lstItem.SubItems(1) = "应收应付"
            lstItem.SubItems(2) = "IncomeAndExpense"
            rSt.Open "select * from tSYS_SubSysUsed where SubSysID='SF' and  AccountID= '" & m_AccountID & "'", _
                      adoCnn, adOpenStatic, adLockReadOnly
            If rSt.RecordCount <> 0 Then
                lstItem.SubItems(3) = rSt.Fields("BeginYear").Value & "年" & _
                        rSt.Fields("BeginMonth").Value & "月启用"
            Else
                lstItem.SubItems(3) = "(尚未启用)"
            End If
            rSt.Close
            
            Set lstItem = .ListItems.Add
            lstItem.text = "USU"
            lstItem.SubItems(1) = "公用信息"
    End With
 Set rSt = Nothing
 Set adoCnn = Nothing
 
End Sub
Private Sub cmdCancel_Click()
    Unload Me
End Sub

Private Sub lvwReports_ItemClick(ByVal Item As MSComctlLib.ListItem)
    If lvwReports.ListItems.Count > 0 Then
        lvwReports.ToolTipText = Item.text & " " & Item.SubItems(1)
        Item.Checked = Not Item.Checked
    End If
End Sub

'检查是否有报表被选择
Private Function bVoild() As Boolean
    Dim i As Integer
    
    bVoild = False
    
    With lvwReports.ListItems
        For i = 1 To .Count
            If .Item(i).Checked = True Then
                bVoild = True
                Exit Function
            End If
        Next i
    End With
    If Not bVoild Then
        MsgBox "没有选择财务子系统！", vbInformation
    End If
        
End Function
Public Property Let GetCnn(ByVal vNewValue As Variant)
 Set m_cnn = vNewValue
End Property
Public Property Let GetTime(ByVal vNewValue As Variant)
 m_Time = vNewValue
End Property
Public Property Let GetAccountID(ByVal vNewValue As Variant)
 m_AccountID = vNewValue
End Property
Public Sub LoadtvwSource()
Dim sCode As String
Dim rSt As New ADODB.Recordset
Dim i As Integer
Dim o As TableFileForXML.clsTBOperate
Set c = New VBA.Collection
m_Comment = ""
If lvwReports.Enabled = False Then
      sCode = "TSYS"
      m_Comment = "财务系统表;"
      If g_FLAT = "SQL" Then
         rSt.Open "select * from sysobjects where name like '" & sCode & "%'", m_cnn, adOpenStatic, adLockReadOnly
      Else
         rSt.Open "select * from sys.dba_tables where TABLE_NAME like '" & sCode & "%' and owner='" & m_AccountID & "'", m_cnn, adOpenStatic, adLockReadOnly
      End If
      Do Until rSt.EOF
         Set o = New TableFileForXML.clsTBOperate
         If g_FLAT = "SQL" Then
         o.uTableName = rSt.Fields("name")
         o.uSelectSQL = "Select * from " & rSt.Fields("name")
         o.uDeleteSQL = "Delete from " & rSt.Fields("name")
         Else
         o.uTableName = rSt.Fields("TABLE_NAME")
         o.uSelectSQL = "Select * from " & rSt.Fields("TABLE_NAME")
         o.uDeleteSQL = "Delete from " & rSt.Fields("TABLE_NAME")
         End If
         c.Add o
         rSt.MoveNext
      Loop
      rSt.Close
      sCode = ""
Else

        For i = 1 To lvwReports.ListItems.Count
           If lvwReports.ListItems.Item(i).Checked = True Then
              m_Comment = m_Comment & lvwReports.ListItems.Item(i).SubItems(1) & "、"
              If lvwReports.ListItems.Item(i).text = "SF" Then
                 sCode = "TYSYF"
              Else
                 sCode = "T" & lvwReports.ListItems.Item(i).text
              End If
              If g_FLAT = "SQL" Then
                 rSt.Open "select * from sysobjects where name like '" & sCode & "%'", m_cnn, adOpenStatic, adLockReadOnly
              Else
                 rSt.Open "select * from sys.dba_tables where TABLE_NAME like '" & sCode & "%' and owner='CWDB" & m_AccountID & "'", m_cnn, adOpenStatic, adLockReadOnly
              End If
              Do Until rSt.EOF
                 Set o = New TableFileForXML.clsTBOperate
                 If g_FLAT = "SQL" Then
                 o.uTableName = rSt.Fields("name")
                 o.uSelectSQL = "Select * from " & rSt.Fields("name")
                 o.uDeleteSQL = "Delete from " & rSt.Fields("name")
                 Else
                 o.uTableName = rSt.Fields("TABLE_NAME")
                 o.uSelectSQL = "Select * from " & rSt.Fields("TABLE_NAME")
                 o.uDeleteSQL = "Delete from " & rSt.Fields("TABLE_NAME")
                 End If
                 c.Add o
                 rSt.MoveNext
              Loop
              rSt.Close
              sCode = ""
           End If
        Next i
End If
End Sub

Private Sub tb_FinishNumber(ByVal l As Long)
DoEvents
pBr.Value = l
'Me.Caption = l
End Sub