-

VB开发的ERP系统

    End If
    
    s = ""
    With coll
        If .count = 0 Then
            s = " " & sPriTableName & Chr(10) & " "
            GetSQLFrom = s
            Exit Function
        End If
        

        Select Case UCase(sPriTableName)
            Case UCase("PM_PayRoll")
                s = " PM_PayRoll left outer join  PM_AttendRecord  " & Chr(10) _
                    & " on  PM_PayRoll.EmpID=PM_AttendRecord.EmpID and PM_PayRoll.Period=PM_AttendRecord.Period and PM_PayRoll.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                    & " Left Outer Join PM_TaxData " & Chr(10) _
                    & " on PM_PayRoll.EmpID=PM_TaxData.EmpID and PM_PayRoll.Period=PM_TaxData.Period and PM_PayRoll.KjYear=PM_TaxData.KjYear and PM_PayRoll.SortID=PM_TaxData.SortID " & Chr(10)
            Case UCase("PM_AttendRecord")
                s = " PM_AttendRecord left outer join  PM_PayRoll  " & Chr(10) _
                    & " on  PM_PayRoll.EmpID=PM_AttendRecord.EmpID and PM_PayRoll.Period=PM_AttendRecord.Period and PM_PayRoll.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                    & " Left Outer Join PM_TaxData " & Chr(10) _
                    & " on PM_AttendRecord.EmpID=PM_TaxData.EmpID and PM_AttendRecord.Period=PM_TaxData.Period and PM_AttendRecord.KjYear=PM_TaxData.KjYear  " & Chr(10)
            Case UCase("PM_TaxData")
                s = " PM_TaxData left outer join  PM_AttendRecord  " & Chr(10) _
                    & " on  PM_TaxData.EmpID=PM_AttendRecord.EmpID and PM_TaxData.Period=PM_AttendRecord.Period and PM_TaxData.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                    & " Left Outer Join PM_PayRoll " & Chr(10) _
                    & " on PM_PayRoll.EmpID=PM_TaxData.EmpID and PM_PayRoll.Period=PM_TaxData.Period and PM_PayRoll.KjYear=PM_TaxData.KjYear and PM_PayRoll.SortID=PM_TaxData.SortID " & Chr(10)
            Case Else
                s = sPriTableName & " Left Outer Join PM_PayRoll on " & Chr(10) _
                    & sPriTableName & ".EmpID=PM_PayRoll.EmpID " & Chr(10) _
                    & " left outer join  PM_AttendRecord  " & Chr(10) _
                    & " on  PM_PayRoll.EmpID=PM_AttendRecord.EmpID and PM_PayRoll.Period=PM_AttendRecord.Period and PM_PayRoll.KjYear=PM_AttendRecord.KjYear " & Chr(10) _
                    & " Left Outer Join PM_TaxData " & Chr(10) _
                    & " on PM_PayRoll.EmpID=PM_TaxData.EmpID and PM_PayRoll.Period=PM_TaxData.Period and PM_PayRoll.KjYear=PM_TaxData.KjYear and PM_PayRoll.SortID=PM_TaxData.SortID  " & Chr(10)
        End Select
                
        '连接剩下的表
        For k = 1 To .count
            If UCase(sPriTableName) <> UCase(.Item(k)) And _
                Trim(UCase(.Item(k))) <> "" And _
                Trim(UCase(.Item(k))) <> UCase("PM_PayRoll") And _
                Trim(UCase(.Item(k))) <> UCase("PM_AttendRecord") And _
                Trim(UCase(.Item(k))) <> UCase("PM_TaxData") Then
                s = s & " left outer join " & Trim(.Item(k)) & " on " & Trim(.Item(k)) & ".EmpID=" & sPriTableName & ".EmpID " & Chr(10)
            End If
        Next k
        
    End With
    GetSQLFrom = s
    Exit Function
ErrCtrl:
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function

Public Function AddTableFrom(coll As Collection, sName As String)
    '添加用户查询必须的表
    On Error GoTo ErrCtrl
    Dim i As Integer
    '如果没有定义查询条件，简单添加表名
    '如果表名集合第一项为“”，则删除第一项
    
    With coll
        If coll.count = 0 Then
            .Add UCase(sName)
            Exit Function
        End If
        If Trim(.Item(1)) = "" Then
            .Remove (1)
        End If
        For i = 1 To .count
            If UCase(.Item(i)) = UCase(sName) Then
                Exit For
            End If
        Next
        If i > .count Then
            .Add UCase(sName)
        End If
    End With
    Exit Function
ErrCtrl:
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function
Public Function IsNodeExist(skey As String, tv As TreeView) As Boolean
    '测试树是否包含Key为skey的节点
    On Error GoTo ErrCtrl
    Dim i As Integer
    With tv
        For i = 1 To .Nodes.count
            If UCase(.Nodes(i).Key) = UCase(skey) Then
                IsNodeExist = True
                Exit Function
            End If
        Next
    End With
    IsNodeExist = False
    Exit Function
ErrCtrl:
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function

Public Function FillValue2TV(sCond As String, tv As TreeView)
    '填充字段的可能值,sCond 的格式为 数字@表名@编码@名称
    On Error GoTo ErrCtrl
    tv.Nodes.Clear
    If Trim(sCond) = "" Then
        Exit Function
    End If
    Dim sID As String
    Dim sTable As String
    Dim sCode As String
    Dim sName As String
    
    Dim rs As New ADODB.Recordset
    Dim s As String
    tv.Nodes.Clear
    
    GetFieldHelp sCond, sID, sTable, sCode, sName
    With tv
        If UCase(sTable) = UCase("GY_Department") Then
            FillDept2TV "RsPmFlag", tv, Cw_DataEnvi.DataConnect
        Else
            If Trim(sID) = "" Or Trim(sTable) = "" Or Trim(sCode) = "" Or Trim(sName) = "" Then
                Set rs = Nothing
                MsgBox "字段帮助出现错误!", vbOKOnly + vbCritical
                Exit Function
            End If
            If Trim(sID) = "0" Then
                s = "select " & sCode & " as TCode, " & sName & " as TName from " & sTable
            Else
                s = "select " & sCode & " as TCode, " & sName & " as TName from " & sTable & " where SortID='" & sID & "'"
            End If
            
            Set rs = Cw_DataEnvi.DataConnect.Execute(s)
            If Not rs.EOF() Then
                .Nodes.Add , , "R", "备选值"
                Do While Not rs.EOF()
                    .Nodes.Add "R", tvwChild, "R" & Trim(rs!TCode), Trim(rs!TName)
                    rs.MoveNext
                Loop
            End If
            
        End If
    End With
    
    Exit Function
ErrCtrl:
    
    Set rs = Nothing
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function

Public Function FillDept2TV(sSysCode As String, tv As TreeView, cn As Connection)
    '填充部门树
    On Error GoTo ErrCtrl
    Dim s As String
    Dim rs As New ADODB.Recordset
    Dim nod As Node
    tv.Enabled = False
    tv.Nodes.Clear
    tv.Nodes.Add , , "R", "部门"
    s = "Select DeptCode,DeptName ,ParentCode from GY_Department where " & sSysCode & "=1 order by CodeLevel"
    Set rs = Cw_DataEnvi.DataConnect.Execute(s)
    With rs
        Do While Not .EOF()
            Set nod = tv.Nodes.Add("R" & Trim(!ParentCode & ""), tvwChild, "R" & Trim(!DeptCode & ""), Trim(!DeptName & ""))
            nod.Tag = Trim(!DeptCode & "")
            If Trim(!ParentCode & "") = "" Then
                nod.EnsureVisible
            End If
            .MoveNext
        Loop
    End With
    Set rs = Nothing
    Set nod = Nothing
    tv.Enabled = True
    Exit Function
ErrCtrl:
    Set nod = Nothing
    Set rs = Nothing
    tv.Enabled = True
    Dim smsg As String
    Dim smsgSys As String
    smsg = GetError(Err.Number)
    smsgSys = Err.Number & Err.Description & "!"
    MsgBox IIf(smsg = "", smsgSys, smsg), vbOKOnly + vbCritical
End Function

Public Function GetTableNameC(sTableName As String) As String
    '设置表的汉语名称
    Dim s As String
    Select Case UCase(sTableName)
        Case UCase("PM_PayRoll")
            s = "工资"
        Case UCase("Rs_BasicInfo")
            s = "基本"
        Case UCase("Rs_ExtendInfo")
            s = "扩展"
        Case UCase("PM_AttendRecord")
            s = "考勤"
        Case Else
            MsgBox "不存在此表"
    End Select
    GetTableNameC = s
End Function

Public Function GetCol(sFields() As CFieldValue, iNoCol As Integer, iNameCol As Integer, Optional iBeginCol As Integer = 0) As Integer
    '成功找到工号或者姓名返回1,没有找到返回0,错误返回-1
    On Error GoTo ErrCtrl
    Dim i As Integer
    iNoCol = -1
    iNameCol = -1
    GetCol = -1
    
    For i = LBound(sFields) To UBound(sFields)
        If Len(sFields(i).FieldName) >= 5 Then
            If UCase(Right(sFields(i).FieldName, 5)) = UCase("EmpNo") Then
                iNoCol = i + iBeginCol
            Else
                If Len(sFields(i).FieldName) >= 7 Then
                    If UCase(Right(sFields(i).FieldName, 7)) = UCase("EmpName") Then
                        iNameCol = i + iBeginCol
                    End If
                End If
            End If
        End If
        If iNameCol >= 0 And iNoCol >= 0 Then
            Exit For
        End If
    Next i
    If iNameCol >= 0 Or iNoCol >= 0 Then
        GetCol = 1
    Else
        GetCol = 0
    End If
    Exit Function
    
ErrCtrl:
    GetCol = -1
        
End Function
Public Function LenByte(str1 As String) As Long
  '计算字符串的字节数
  Dim i As Long
  Dim chr1 As String
  LenByte = 0
  str1 = Trim(str1)
  For i = 1 To Len(str1)
    chr1 = Mid(str1, i, 1)
    If Asc(chr1) >= 0 And Asc(chr1) <= 255 Then
      LenByte = LenByte + 1
    ElseIf Asc(chr1) < 0 Then   '汉字
      LenByte = LenByte + 2
    End If
  Next
End Function


Public Function PrintGrid(vs As vsFlexGrid, iVsBeginCol As Integer, iVsSumEndCol As Integer, sRCode As String, frmSetup As DY_Dyymsz, Optional bPrint As Boolean = False)
    '打印网格
    On Error GoTo ErrCtrl
    
    Dim i As Long
    Dim j As Long
    Dim k As Long
    Dim m As Long
    Dim n As Long
    Dim s As String
    Dim bNext As Boolean '临时变量
    Dim bSumRow As Boolean '是否是合计行
    Dim iStartCol As Long '打印数据开始列
    Dim rs As New ADODB.Recordset
    '--------------------------------------------------控制信息-------------------------------------------------
    Dim iPrintStyle As Integer '打印方式 0每页输出一个表头 1每行输出一个表头
    Dim iSumPerPage As Integer '1每页输出合计
    Dim iSplitPage As Integer '1分页打印