专家坐堂-[求助]如何写抽取题目代码？Foxtable(狐表) - 新一代数据库软件，完美融合Access、Foxpro、Excel、vb.net之优势，人人都能掌握的快速软件开发工具!

以文本方式查看主题

-  Foxtable(狐表)  (http://foxtable.com/bbs/index.asp)
--  专家坐堂  (http://foxtable.com/bbs/list.asp?boardid=2)
----  [求助]如何写抽取题目代码？  (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=110218)

--  作者：hrw68529
--  发布时间：2017/11/29 10:09:00
--  [求助]如何写抽取题目代码？
根据上传例子，请专家帮一下，打开软件后，点“抽课主窗口－－题目抽取”，在上表中选择中选中一行，在中间选择“学段”、“学科”、“教材版本”后，点：抽取题目按钮，随机抽取一题，然后，将抽取的内容写在上表选择的行的“学科”、“教材版本”、“学段”、“学期”、“年级”、“讲课题目”中，如何在“抽取题目”中写代码，别外，在上表中“选择”中方框中点击后显示对号后，再选择另一行时，上行对号取消。
例子：
下载信息  [文件大小：   下载次数： ]
点击浏览该文件:河南省高级专业技术职务任职资格评审面试抽签系统.zip

--  作者：hrw68529
--  发布时间：2017/11/29 10:09:00
--
截图：
此主题相关图片如下：截图00.jpg

--  作者：有点甜
--  发布时间：2017/11/29 10:32:00
--

按钮代码

Dim Filter As String

With e.Form.Controls("学段")
    If .Value IsNot Nothing Then
        Filter = "学段 = \'" & .Value & "\'"
    End If
End With
With e.Form.Controls("学科")
    If .Value IsNot Nothing Then
        If Filter >"" Then
            Filter = Filter & " And "
        End If
        Filter = Filter & "学科 = \'" & .Value & "\'"
    End If
End With

With e.Form.Controls("教材版本")
    If .Value IsNot Nothing Then
        If Filter >"" Then
            Filter = Filter & " And "
        End If
        Filter = Filter & "教材版本 = \'" & .Value & "\'"
    End If
End With

Tables("题目抽取_题库").Filter = Filter

Dim lst As new List(of String)
Dim cnt As Integer = Tables("题目抽取_题库").rows.count
Dim i As Integer = Rand.Next(cnt)
Dim r As Row = Tables("题目抽取_题库").rows(i)
Dim cr As Row = Tables("题目抽取_人员").current
cr("学科") = r("学科")
cr("教材版本") = r("教材版本")
cr("讲课题目") = r("题目")

取消勾选，参考代码，AfterEdit事件

If e.Col.name = "选择" Then
    If e.Row("选择") = True Then
        For Each r As Row In e.Table.Rows
            r("选择") = False
        Next
        e.Row("选择") = True
    End If
End If

--  作者：hrw68529
--  发布时间：2017/11/29 10:36:00
--
谢谢，我试试

--  作者：hrw68529
--  发布时间：2017/11/29 10:40:00
--
有点甜，当抽取题目后，本行不能再进行抽取，并提示，怎么写呢，谢谢

--  作者：有点甜
--  发布时间：2017/11/29 10:47:00
--

以下是引用hrw68529在2017/11/29 10:40:00的发言：
有点甜，当抽取题目后，本行不能再进行抽取，并提示，怎么写呢，谢谢

Dim cr As Row = Tables("题目抽取_人员").current

If cr.IsNull("题目") = False Then

    msgbox("题目已存在，不能抽取")

    return

End If

--  作者：hrw68529
--  发布时间：2017/11/29 11:57:00
--
运行非常棒，但，当选择“教材版本”，如果没有这个教材版本的，就退出，进入自选抽课，但代码运行时，即使没有，也在上表填写内容，怎么回事？请看代码和截图
代码：Dim Filter As String
With e.Form.Controls("学段")
If .Value IsNot Nothing Then
Filter = "学段 = \'" & .Value & "\'"
End If
End With
With e.Form.Controls("学科")
If .Value IsNot Nothing Then
If Filter >"" Then
Filter = Filter & " And "
End If
Filter = Filter & "学科 = \'" & .Value & "\'"
End If
End With
With e.Form.Controls("教材版本")
If .Value IsNot Nothing Then
If Filter >"" Then
Filter = Filter & " And "
End If
Filter = Filter & "教材版本 = \'" & .Value & "\'"
End If
End With
Tables("题目抽取_题库").Filter = Filter

Dim cr As Row = Tables("题目抽取_人员").current
If cr.IsNull("讲课题目") = False Then
msgbox("题目已存在,不能抽取")
Return
End If

Dim lst As new List(of String)
Dim cnt As Integer = Tables("题目抽取_题库").rows.count

Dim i As Integer = Rand.Next(cnt)
MessageBox.Show("是否抽取题目?第一次确认", "提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
MessageBox.Show("是否抽取题目?第二次确认", "提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
MessageBox.Show("是否抽取题目?第三次确认", "提示", MessageBoxButtons.YesNo, MessageBoxIcon.Question)
Dim r As Row = Tables("题目抽取_题库").rows(i)
If r.IsNull("教材版本") = True Then
msgbox("教材版本不存在,请进入自选抽课!")
Return
ElseIf r.IsNull("教材版本") = False Then
cr("学科") = r("学科")
cr("学段") = r("学段")
cr("学期") = r("学期")
cr("年级") = r("年级")
cr("教材版本") = r("教材版本")
cr("讲课题目") = r("题目")
End If

截图：
此主题相关图片如下：截图01.jpg

--  作者：有点甜
--  发布时间：2017/11/29 12:16:00
--

Tables("题目抽取_题库").Filter = Filter

If Tables("题目抽取_题库").Rows.count = 0 Then

    msgbox("不存在")

    return

End if