以文本方式查看主题

-  Foxtable(狐表)  (http://www.foxtable.com/bbs/index.asp)
--  专家坐堂  (http://www.foxtable.com/bbs/list.asp?boardid=2)
----  web复选框的保存  (http://www.foxtable.com/bbs/dispbbs.asp?boardid=2&id=177227)

--  作者:cd_tdh
--  发布时间:2022/5/13 13:14:00
--  web复选框的保存

老师,请教一下,我这样的表结构,web页面怎么保存,表结构如下

 


图片点击可在新窗口打开查看此主题相关图片如下:实名制考勤表.jpg
图片点击可在新窗口打开查看


 web页面如下:


图片点击可在新窗口打开查看此主题相关图片如下:2222.jpg
图片点击可在新窗口打开查看

 

保存逻辑:复选框哪儿勾选后,如果是2022年5月,当月由这个人考勤数据的,就在对应的日那一列画√,勾选的画×,没有的就新增,5月结束,6月1日就所有人员新增,复选框勾选的,6月1日的考勤数据就是复选框勾选的画√,没勾选的画×

 


[此贴子已经被作者于2022/5/13 13:23:58编辑过]

--  作者:有点蓝
--  发布时间:2022/5/13 13:44:00
--  
先获取页面勾选的考勤人员姓名放入一个集合,然后遍历表格所有行,判断姓名在集合中的就画√,不在集合的画×
--  作者:cd_tdh
--  发布时间:2022/5/13 14:05:00
--  

勾选的人员的集合怎么写呢

Dim e As object = args(0)
Dim wb As New weui
wb.AppendHTML("<link rel=\'stylesheet\' href=\'./weui/exweui.css\'/>", True)
wb.AppendHTML("<script src=\'./weui/exweui.js\' ></script>", True)
If e.PostValues.Count = 0 Then
    wb.AddForm("","form1","Rename_checking.htm")
    With wb.AddInputGroup("form1","考勤日期","请选择考勤日期")
        With .AddInput("考勤日期","考勤日期","date")
        End With
    End With
    Dim cdg As ExWeUI.ExCheckGroup = ExWeUI.WebUI.AddCheckGroup("", "在岗人员", "请选择考勤人员")
    Dim drs As  List(of  DataRow) = DataTables("实名制管理").SQLSelect("项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")
    If drs.Count > 0 Then
        For Each dr As DataRow In drs
            Dim s As String = dr("姓名")
            If s.Length = 2 Then
                Dim s1 As String = s.PadRight(3)
                cdg.add(dr("_Identify"),s1 & "&emsp;")
            Else
                cdg.add(dr("_Identify"),s)
            End If
        Next
        wb.InsertHTML("form1", cdg.BuildHtml)
        wb.AppendHTML("<script>initExWeUI();</script>") \'需要注意的是,这里不需要使用true参数
        \'添加底部返回及保存按钮
        wb.InsertHTML("<div style=\'height:50px\'></div>")
        wb.AddPage("form1","page1").Attribute = "style=\'position: fixed;bottom: 0;right: 0;left: 0\'" \'增加两个page
        With wb.AddButtonGroup("page1","btg1", False)
            .Add("btn1", "返回", ,"", "Rename.htm")
            .Add("btn2", "保存", "button").Attribute = "" \'调用js函数上传
        End With
        e.WriteString(wb.Build)
    Else
        With wb.AddMsgPage("","msgpage","提示","该项目还未添加实名制登记人员,不能上报考勤数据!")
            .icon = "info"   \'改变图标"success","info","warn",对应的图标分别是
            .AddButton("btn1","返回").Attribute = ""
        End With
        e.WriteString(wb.Build)
        Return Nothing \'必须返回
    End If
Else
    Dim d As Date =  e.PostValues("考勤日期")
    If d = Nothing Then
        Return Nothing \'必须返回
    End If
    For Each r As WinForm.ListViewRow In lvw.Rows
        Dim dr As DataRow = DataTables("实名制考勤").SQLFind("项目名称 = \'" & _Userxmmc & "\' and 年 = \'" & d.Year & "\' and 月 = \'" & d.Month & "\'")
        If dr Is Nothing Then
            dr = DataTables("实名制考勤").AddNew
            dr("年") = d.Year
            dr("月") = d.Month
            If r.Checked = True
                dr("日" & d.Day) = "√"
            Else
                dr("日" & d.Day) = "×"
            End If
        End If
    Next
End If


--  作者:有点蓝
--  发布时间:2022/5/13 14:18:00
--  
……
        For Each dr As DataRow In drs
            Dim s As String = dr("姓名")
            If s.Length = 2 Then
                Dim s1 As String = s.PadRight(3)
                cdg.add("考勤人员_" & dr("_Identify"),s1 & "&emsp;").value = dr("姓名")
            Else
                cdg.add("考勤人员_" & dr("_Identify"),s).value = dr("姓名")
            End If
        Next
……
Else
    Dim d As Date =  e.PostValues("考勤日期")
    If d = Nothing Then
        Return Nothing \'必须返回
    End If
dim lst as new list(of string)
for each key as string in e.postvalues.Keys
if key like "考勤人员_*" then
lst.add(e.postvalues(key))
end if
next
for each ss as string in DataTables("实名制管理").SQLgetvalues("项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")
        Dim dr As DataRow = DataTables("实名制考勤").SQLFind("项目名称 = \'" & _Userxmmc & "\' and 年 = \'" & d.Year & "\' and 月 = \'" & d.Month & "\' and 姓名=\'" & ss & "\'")
        If dr Is Nothing Then
            dr = DataTables("实名制考勤").AddNew
            dr("项目名称") = _Userxmmc
            dr("姓名") = ss
end if
            dr("年") = d.Year
            dr("月") = d.Month
            If lst.contains(ss)
                dr("日" & d.Day) = "√"
            Else
                dr("日" & d.Day) = "×"
            End If
End If

--  作者:cd_tdh
--  发布时间:2022/5/13 15:29:00
--  

还请老师看看,我保存了,但是没有保存成功呢

......

Else

    If e.PostValues.ContainsKey("考勤日期") = False Then  \'生成错误提示页
        With wb.AddMsgPage("","msgpage","提示", "考勤日期不能为空!")
            .icon = "Warn" \'改变图标
            .AddButton("btn1","返回").Attribute = ""
        End With
        e.WriteString(wb.Build)
        Return Nothing \'必须返回
    End If
    Dim lst As new List(of String)
    For Each key As String In e.postvalues.Keys
        If key Like "考勤人员_*" Then
            lst.add(e.postvalues(key))
        End If
    Next
    Dim d As Date =  e.PostValues("考勤日期")
    For Each ss As String In DataTables("实名制管理").SQLGetvalues("项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")
        Dim dr As DataRow = DataTables("实名制考勤").SQLFind("项目名称 = \'" & _Userxmmc & "\' and 年 = \'" & d.Year & "\' and 月 = \'" & d.Month & "\' and 姓名=\'" & ss & "\'")
        If dr Is Nothing Then
            dr = DataTables("实名制考勤").AddNew
            dr("所属机构") = _UserGroup
            dr("项目名称") = _Userxmmc
            dr("姓名") = ss
            dr("年") = d.Year
            dr("月") = d.Month
        End If
        If lst.contains(ss)
            dr("日" & d.Day) = "√"
        Else
            dr("日" & d.Day) = "×"
        End If
    Next
    DataTables("实名制考勤").Save
    \'保存并生成增加成功提示页面
    With wb.AddMsgPage("","msgpage","保存成功", "你是否继续修改其他人员退场信息") \'生成成功提示页
        .AddButton("btn1","继续考勤","Rename_checking.htm")
        .AddButton("btn2","首&emsp;&emsp;页","default.htm")
    End With
    e.WriteString(wb.Build)
End If


--  作者:有点蓝
--  发布时间:2022/5/13 15:32:00
--  
使用dr.save。SQLFind的行要单独保存
--  作者:cd_tdh
--  发布时间:2022/5/13 15:53:00
--  
老师,用dr还是一样,新增的也没保存
--  作者:有点蓝
--  发布时间:2022/5/13 16:06:00
--  

.....学会调试


        Return Nothing \'必须返回
    End If
    Dim lst As new List(of String)
    For Each key As String In e.postvalues.Keys

msgbox("key=” & key)

        If key Like "考勤人员_*" Then
            lst.add(e.postvalues(key))
        End If
    Next

msgbox(lst.count)
    Dim d As Date =  e.PostValues("考勤日期")
    For Each ss As String In DataTables("实名制管理").SQLGetvalues("项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")

msgbox("ss=" & ss)

msgbox("项目名称 = \'" & _Userxmmc & "\' and 年 = \'" & d.Year & "\' and 月 = \'" & d.Month & "\' and 姓名=\'" & ss & "\'")

        Dim dr As DataRow = DataTables("实名制考勤").SQLFind("项目名称 = \'" & _Userxmmc & "\' and 年 = \'" & d.Year & "\' and 月 = \'" & d.Month & "\' and 姓名=\'" & ss & "\'")

msgbox("dr=" & dr Is Nothing)
        If dr Is Nothing Then
            dr = DataTables("实名制考勤").AddNew
            dr("所属机构") = _UserGroup
            dr("项目名称") = _Userxmmc
            dr("姓名") = ss
            dr("年") = d.Year
            dr("月") = d.Month
        End If

msgbox("cline-height: 20px;">        If lst.contains(ss)
            dr("日" & d.Day) = "√"
        Else
            dr("日" & d.Day) = "×"
        End If
    Next
    DataTables("实名制考勤").Save


--  作者:cd_tdh
--  发布时间:2022/5/13 16:30:00
--  

终于找到了,没注意看老师写的,我开始调试了,就是ss没值为空,没找到问题,问题出在这儿

For Each ss As String In DataTables("实名制管理").SQLGetvalues("项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")

 

For Each ss As String In DataTables("实名制管理").SQLGetvalues("姓名", "项目名称 = \'" & _Userxmmc & "\' and 在岗状态 = \'在岗\'")


--  作者:有点蓝
--  发布时间:2022/5/13 16:50:00
--  
我这边没有办法调试,很多时候都是凭感觉手打的,不能只是全盘接收,所以要自己学会调试
[此贴子已经被作者于2022/5/13 16:50:48编辑过]