优先事项表?

时间:2013-11-15 16:24:16

标签: sql vba ms-access access-vba

我很想知道是否有办法根据优先级制作表格?

就像你有一个表格,子表格(数据表)和2个按钮一样。

子表单从查询中获取数据,该查询从表中获取数据。

从这里,查询显示项目。您可以在子窗体上选择项目,然后单击按钮以确定优先级,这将在列表上向下移动1个项目。如果单击inc按钮,则会将其向上移动。如果它位于最底部并且您单击减少按钮,则会弹出“此项目已经是最低优先级!”与增加相同,但它会说它已经是最高的。

这可能吗?我真的不知道任何VBA访问子表格的数据表并对其进行修改,我想学习。

更新: 我有1个表,有5个优先级类型和1个密钥。 该表名为ProjectsT,密钥名为ProjectID,其中5个优先级为: CuttingPriority,ProjPriority,EngineerPriority,CutplanPriority,HardwarePriority。每个优先级都列为数字数据类型。

这是我到目前为止对于以下答案中的按钮的一组代码: 向上按钮:

Dim strSQL As String
Dim intSavePos As Integer
Dim intSavePosMin As Integer
Dim intSavePosMax As Integer

'Save start and end value (It's assumed you start with 1 ! The value 0 (zero) is used for swapping value's)
intSavePosMin = DMin("CuttingPriority", "ProjectsT")
intSavePosMax = DMax("CuttingPriority", "ProjectsT")
'When the subform is linked to a keyfield use that field for a WHERE like:
'intSavePosMin = DMin("sequence", "tblTableNico5038", "Function='" & Me.sfrmFunctionTables.Form.Function & "'")
'intSavePosMax = DMax("sequence", "tblTableNico5038", "Function='" & Me.sfrmFunctionTables.Form.Function & "'")

intSavePos = Me.txtCuttingPriority
'is it the first ? ==> no action
If intSavePos = intSavePosMin Then Exit Sub
'switch positions
DoCmd.SetWarnings False
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = 0 WHERE CuttingPriority=" & intSavePos & ";"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = 0 WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=" & intSavePos & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos & " WHERE CuttingPriority=" & intSavePos - 1 & ";"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = " & intSavePos & " WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=" & intSavePos - 1 & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos - 1 & " WHERE CuttingPriority=0;"
'When the subform is linked to a keyfield use that field for a WHERE like:
'strSQL = "UPDATE tblTableNico5038 SET tblTableNico5038.Sequence = " & intSavePos - 1 & " WHERE Function='" & Me.sfrmTableNico5038.Form.Function & "' AND sequence=0;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

Me.Refresh
Me.ProjectsTCuttingSubF.SetFocus
SendKeys ("{up}")

向下按钮:

Dim strSQL As String
Dim intSavePos As Integer
Dim intSavePosMin As Integer
Dim intSavePosMax As Integer

intSavePosMin = DMin("CuttingPriority", "ProjectsT")
intSavePosMax = DMax("CuttingPriority", "ProjectsT")

intSavePos = Me.txtCuttingPriority
'is it the last ? ==> no action
If intSavePos = intSavePosMax Then Exit Sub
'switch positions
DoCmd.SetWarnings False
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = 0 WHERE CuttingPriority=" & intSavePos & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos & " WHERE CuttingPriority=" & intSavePos + 1 & ";"
DoCmd.RunSQL strSQL
strSQL = "UPDATE ProjectsT SET ProjectsT.CuttingPriority = " & intSavePos + 1 & " WHERE CuttingPriority=0;"
DoCmd.RunSQL strSQL
DoCmd.SetWarnings True

Me.Refresh
Me.ProjectsTCuttingSubF.SetFocus
SendKeys ("{down}")

-

3 个答案:

答案 0 :(得分:3)

我很想知道我是否能想出一个不采用“SQL粘合”的解决方案。结果可供下载here(Access 2010或更高版本)。

关键组件是[经理]表

ID  ManagerName
--  --------------
 1  Thompson, Gord
 2  Elk, Anne

a [Projects]表

ID  ManagerID  Description           Priority
--  ---------  --------------------  --------
 1          1  buy bacon                    1
 2          1  wash the car                 2
 3          1  clean out the garage         3
 4          2  test1                        1
 5          2  test2                        2

两个已保存的参数查询(QueryDef s),用于查找下一个最高/最低优先级项目

[GetHigherPriorityProject]

PARAMETERS prmManagerID Long, prmCurrentPriority Long;
SELECT TOP 1 Projects.ID, Projects.Priority
FROM Projects
WHERE (((Projects.Priority)<[prmCurrentPriority]) 
    AND ((Projects.ManagerID)=[prmManagerID]))
ORDER BY Projects.Priority DESC , Projects.ID;

[GetLowerPriorityProject]

PARAMETERS prmManagerID Long, prmCurrentPriority Long;
SELECT TOP 1 Projects.ID, Projects.Priority
FROM Projects
WHERE (((Projects.Priority)>[prmCurrentPriority]) 
    AND ((Projects.ManagerID)=[prmManagerID]))
ORDER BY Projects.Priority, Projects.ID;

再保存一个参数查询以更新给定项目的优先级

[SetProjectPriority]

PARAMETERS prmNewPriority Long, prmID Long;
UPDATE Projects SET Projects.Priority = [prmNewPriority]
WHERE (((Projects.ID)=[prmID]));

一个简单的类只是为了保存几个属性

[projectInfo]

Option Compare Database
Option Explicit

Private pID As Long, pPriority As Long

Public Property Get ID() As Long
    ID = pID
End Property

Public Property Let ID(Value As Long)
    pID = Value
End Property

Public Property Get Priority() As Long
    Priority = pPriority
End Property

Public Property Let Priority(Value As Long)
    pPriority = Value
End Property

带子表单的基本表单

ManagersForm.png

以及该表单背后的代码

Option Compare Database
Option Explicit

Private Sub cmdMoveDown_Click()
    AdjustPriority "lower"
End Sub

Private Sub cmdMoveUp_Click()
    AdjustPriority "higher"
End Sub

Private Sub AdjustPriority(Direction As String)
    Dim cdb As DAO.Database, rst As DAO.Recordset, qdf As DAO.QueryDef
    Dim currentProjectID As Long, otherProject As projectInfo

    Set rst = Me.ProjectsSubform.Form.RecordsetClone
    rst.Bookmark = Me.ProjectsSubform.Form.Recordset.Bookmark
    currentProjectID = rst!ID
    Set otherProject = GetOtherProject(rst!ManagerID, rst!Priority, Direction)
    If otherProject.ID = 0 Then
        MsgBox "There is no project with a " & Direction & " priority."
    Else
        Set cdb = CurrentDb
        Set qdf = cdb.QueryDefs("SetProjectPriority")
        ' swap priorities
        qdf!prmNewPriority = rst!Priority
        qdf!prmID = otherProject.ID
        qdf.Execute
        qdf!prmNewPriority = otherProject.Priority
        qdf!prmID = currentProjectID
        qdf.Execute
        Set qdf = Nothing
        Set cdb = Nothing
        Me.ProjectsSubform.Requery
        ' now restore the previous current record in the subform
        Set rst = Me.ProjectsSubform.Form.RecordsetClone
        rst.FindFirst "ID=" & currentProjectID
        Me.ProjectsSubform.Form.Recordset.Bookmark = rst.Bookmark
    End If
    rst.Close
    Set rst = Nothing
    Set otherProject = Nothing
End Sub

Private Function GetOtherProject(prmManagerID As Long, _
        prmCurrentPriority As Long, _
        Direction As String) As projectInfo
    Dim cdb As DAO.Database, qdf As DAO.QueryDef, rst As DAO.Recordset
    Dim rtn As New projectInfo

    Set cdb = CurrentDb
    If Direction = "higher" Then
        Set qdf = cdb.QueryDefs("GetHigherPriorityProject")
    Else
        Set qdf = cdb.QueryDefs("GetLowerPriorityProject")
    End If
    qdf!prmManagerID = prmManagerID
    qdf!prmCurrentPriority = prmCurrentPriority
    Set rst = qdf.OpenRecordset(dbOpenSnapshot)
    If rst.EOF Then
        rtn.ID = 0
        rtn.Priority = 0
    Else
        rtn.ID = rst!ID
        rtn.Priority = rst!Priority
    End If
    rst.Close
    Set rst = Nothing
    Set qdf = Nothing
    Set cdb = Nothing
    Set GetOtherProject = rtn
    Set rtn = Nothing
End Function

编辑重新评论

  

如果您要通过其他表单添加记录,有没有办法让它自动在列表中添加下一个优先级号码?

是。我忘了提到在现有的示例解决方案中,[Projects]表上有一个Before Change数据宏来做到这一点:

If [IsInsert] Then
    If Not IsNull([ManagerID]) Then
        SetField
            Name      Priority
            Value =   Nz(DMax("Priority", "Projects", "ManagerID=" & [ManagerID]), 0) + 1
    End If
End If

答案 1 :(得分:0)

我的工作场所有工作单系统,为了创建优先级,我创建了两个表:Work_TicketsWork_Ticket_Criteria。条件表有一个低,低中等的列表......以及Work_Tickets中的一个字段来自第二个表。然后按日期排序。

它不会像您要查找的那样为单个票证提供数字优先级,因为这样做我相信您必须创建一个单独的字段,然后在每次更新后修改每个记录的数字字段。切换1为2,或者创建新记录1,然后在每个记录的优先级字段中加1,将其移到列表中。

或者,如果你从1000这样的数字开始,那么你可以以5,10或20的增量创建多于或少于100的记录但是你最终会用完数字......

更新

如果您愿意使用我添加其他列的方法,那么我只需添加列并命名字段Priority_Numbers或其他内容。然后你将每个标记为1 - 除了你可能想要检查以确保你的号码不存在,只需将它作为一个键或给它一个支票。

然后,每次您想要查看门票时,您都会使用以下内容:

Dim strSQL As String
Dim myR As Recordset

strSQL = "SELECT * FROM table_name WHERE criteria_here ORDER BY Priority_Numbers ASC"

Set myR = CurrentDb.OpenRecordset(strSQL, dbOpenDynaset)

并且你有优先顺序列表。

现在要更改您需要选择该记录集的优先级,执行findfirst以获取您想要替换的值的记录,在While not EOF循环中为每个优先级编号+1或-1并继续移动下一个。如果您的门票太高,这将变得乏味。我很有信心。

答案 2 :(得分:0)

在此处阅读整个对话:

re-order a records sequence using up and down buttons

您将需要了解VBA以及如何将您的特定数据应用于预先存在的示例。这个人几乎正在寻找你的问题描述的内容,与他合作的人是Access MVP。我说要阅读整个对话,因为在解决方案过程中进行了多次迭代和调整。

如果您在整合此解决方案后有任何具体问题,请随时回来询问。