bas_sysfunc.bas

生产计划管理等信息 可以查询计划完成情况等

Attribute VB_Name = "Bas_SysFunc"
'系统共用

Public Sub DepartToCombo(combo As ComboBox)
'部门信息导入combo
    Dim k As Variant
    On Error GoTo ErrMsg
      combo.Clear
      If rs.State = 1 Then rs.Close
      rs.Open "部门信息", DBConn, adOpenKeyset, adLockOptimistic, adCmdTable
      If Not rs.EOF Then
         rs.MoveFirst
         For k = 1 To rs.RecordCount
           combo.AddItem Trim(rs.Fields("部门名称").Value), k - 1
           rs.MoveNext
         Next k
      End If
    Exit Sub
ErrMsg:
       MsgBox Err.Description & vbCrLf & vbCrLf & "提示：请检查数据库配置！", vbInformation, "数据库操作失败"
End Sub

Public Sub TeamsToCombo(combo As ComboBox, Bumen As String)
'部门信息导入combo
    Dim k As Variant
    On Error GoTo ErrMsg
      combo.Clear
      If rs.State = 1 Then rs.Close
      rs.Open "select * from 班组信息 where 部门名称='" & Bumen & "'", DBConn, adOpenKeyset, adLockOptimistic, adCmdText
      If Not rs.EOF Then
         rs.MoveFirst
         For k = 1 To rs.RecordCount
           combo.AddItem Trim(rs.Fields("班组名称").Value), k - 1
           rs.MoveNext
         Next k
      End If
    Exit Sub
ErrMsg:
       MsgBox Err.Description & vbCrLf & vbCrLf & "提示：请检查数据库配置！", vbInformation, "数据库操作失败"
End Sub

Public Sub MeterTypeToCombo(combo As ComboBox, Bumen As String)
'部门信息导入combo
    Dim k As Variant
    On Error GoTo ErrMsg
      combo.Clear
      If rs.State = 1 Then rs.Close
      rs.Open "select * from 表计类型 where 部门名称='" & Bumen & "' ", DBConn, adOpenKeyset, adLockOptimistic, adCmdText
      If Not rs.EOF Then
         rs.MoveFirst
         For k = 1 To rs.RecordCount
           combo.AddItem Trim(rs.Fields("表计类型").Value), k - 1
           rs.MoveNext
         Next k
      End If
    Exit Sub
ErrMsg:
       MsgBox Err.Description & vbCrLf & vbCrLf & "提示：请检查数据库配置！", vbInformation, "数据库操作失败"
End Sub

Public Sub MeterTypeToList(List As ListBox, Bumen As String)
'部门信息导入List
    Dim k As Variant
    On Error GoTo ErrMsg
      List.Clear
      If rs.State = 1 Then rs.Close
      rs.Open "select * from 表计类型 where 部门名称='" & Bumen & "' ", DBConn, adOpenKeyset, adLockOptimistic, adCmdText
      If Not rs.EOF Then
         rs.MoveFirst
         For k = 1 To rs.RecordCount
           List.AddItem Trim(rs.Fields("表计类型").Value), k - 1
           rs.MoveNext
         Next k
      End If
    Exit Sub
ErrMsg:
       MsgBox Err.Description & vbCrLf & vbCrLf & "提示：请检查数据库配置！", vbInformation, "数据库操作失败"
End Sub


'========================================================================
Public Sub LoadTimeFA(combo As ComboBox)
'导入时制方案
    Dim k As Variant
    k = 0
    On Error GoTo ErrMsg
      combo.Clear
      If rs.State = 1 Then rs.Close
      rs.Open "select 方案 from 休息时间 group by 方案", DBConn, adOpenKeyset, adLockOptimistic, adCmdText
      Do While Not rs.EOF
         combo.AddItem Trim(rs.Fields("方案").Value), k
         rs.MoveNext
      Loop
    Exit Sub
ErrMsg:
       MsgBox Err.Description & vbCrLf & vbCrLf & "提示：请检查数据库配置！", vbInformation, "数据库操作失败"
End Sub

'========================================================================

Public Function TestPlanID(PlanID_9 As String) As Boolean
'检测计划单信息是否存在
    TestPlanID = False
    SQL = "Select * from 计划信息 where 计划单号='" & Mid(PlanID_9, 1, 7) & "' and 批次号='" & Mid(PlanID_9, 8, 2) & "'"
    If rstmp.State = 1 Then rstmp.Close
    rstmp.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
    If Not rstmp.EOF Then TestPlanID = True
End Function

Public Function GetSubPlanID(PlanID_9 As String) As String
'自动生成子批次信息
    SQL = "Select * from 生产计划 where 计划单号='" & Mid(PlanID_9, 1, 7) & "' and 批次号='" & Mid(PlanID_9, 8, 2) & "'"
    If rs.State = 1 Then rs.Close
    rs.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
    If Not rs.EOF Then
       SQL = "Select max(子批次号)+1 as pici from 生产计划 where 计划单号='" & Mid(PlanID_9, 1, 7) & "' and 批次号='" & Mid(PlanID_9, 8, 2) & "'"
       If rs.State = 1 Then rs.Close
       rs.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
       If Not rs.EOF Then
         Dim pc As String
         pc = rs.Fields("pici").Value
         GetSubPlanID = AddZero(2 - Len(pc)) & pc
       End If
    Else
       GetSubPlanID = "01"
    End If

End Function

Public Function TestNum(PlanID_9 As String, UseNum As String) As Boolean
'检测计划单信息中剩余数量是否够用
    TestNum = False
    SQL = "Select * from 计划信息 where 计划单号='" & Mid(PlanID_9, 1, 7) & "' and 批次号='" & Mid(PlanID_9, 8, 2) & "'"
    If rstmp.State = 1 Then rstmp.Close
    rstmp.Open SQL, DBConn, adOpenKeyset, adLockOptimistic, adCmdText
    If Not rstmp.EOF Then
      If Val(UseNum) > Val(rs.Fields("剩余表计").Value) Then
         TestNum = False
      Else
         TestNum = True
      End If
    End If
End Function

Public Sub ConvertFont(f As Form)
On Error Resume Next
 For Each Control In f.Controls
    Control.Font.Name = Font_Name ' ' "Tahoma" '"宋体"
    Control.Font.Size = Font_Size
 Next
End Sub