Foxtable(狐表)用户栏目专家坐堂 → 求助:怎么实现表格数据准确标注呢?


  共有1700人关注过本帖树形打印复制链接

主题:求助:怎么实现表格数据准确标注呢?

帅哥哟,离线,有人找我吗?
李孝春
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:九尾狐 帖子:2472 积分:17346 威望:0 精华:0 注册:2013/1/31 0:03:00
求助:怎么实现表格数据准确标注呢?  发帖心情 Post By:2016/11/23 19:58:00 [只看该作者]

想将红色部分标注在箭头位置,下面两个代码怎么修正呢?

图片点击可在新窗口打开查看此主题相关图片如下:6a8f.tm.png
图片点击可在新窗口打开查看
代码一:(按钮事件代码里)
'DataTables("图文群发每日数据").DataRows.Clear
If Forms("主窗体").opened=True Then
    Dim ab As Date =DataTables("微信图文素材列表").compute("Max(更新时间)")
    Dim abc As Date ="2014-12-01"
    Dim t As TimeSpan = ab - abc
    Dim dr As DataRow
    'Tables("微信图文素材列表").StopRedraw
    Try
        For i As Integer = 0 To t.Days
            Dim str As Date = abc.AddDays(i)
            Dim fdr As DataRow = DataTables("图文群发每日数据").Find("操作日期 = '" & Format(str, "yyy-MM-dd") & "'")
            If fdr IsNot Nothing Then
                Continue For
            End If
            dr = DataTables("图文群发每日数据").AddNew()
            dr("操作日期") = Format(str, "yyy-MM-dd")
            dr("单位")=  Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name
        Next
        Catch
    Finally
        'Tables("图文群发每日数据").ResumeRedraw
    End Try
End If

代码二:(表列改变事件里)
'...
Select Case e.DataCol.Name
    Case "操作日期"
        If e.NewValue IsNot Nothing Then
            
            Dim str As String=Format(e.NewValue , "yyy-MM-dd")
            'MessageBox.Show(str)
            Dim postdata As String ="{""begin_date"": """ & str & """, ""end_date"": """ & str & """ }"
            
            'MessageBox.Show(postdata)
            Dim dr1 As DataRow =DataTables("微信基础表").Find("公众号名称 = '" & Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name & "'")
            'MessageBox.Show("公众号名称 = '" & Forms("主窗体").Controls("Treeview1").SelectedNode.ParentNode.Name & "'")
            Dim url = String.Format("https://api.weixin.qq.com/datacube/getarticlesummary?access_token=" & dr1("ACCESSTOKEN") & "")
            'MessageBox.Show(url)
            Using ms As New System.IO.MemoryStream()
            Dim bytes = ConvertHelper.EncodingToBytes(postdata, System.Text.Encoding.UTF8)
            ms.Write(bytes, 0, bytes.Length)
            ms.Seek(0, System.IO.SeekOrigin.Begin)
            Dim jsonString = Functions.Execute("HttpPost",url, ms) '通过POST向接口传输菜单数据,并取得返回结果
            Dim json As String = jsonString
            Dim ScriptControl As Object, data  As Object, JscriptCode As String
            JscriptCode = "function toObject(json) {eval(""var o=""+json);return o;}"
            ScriptControl = CreateObject("MSScriptControl.ScriptControl")
            With ScriptControl
                .Language = "Javascript"
                .Timeout = -1
                .AddCode(JscriptCode)
                data = .Run("toObject", json)
            End With
            'MessageBox.Show(json)
         
            
            Dim haserror As Boolean
            If jsonString.Contains("errcode") Then
                Output.Logs("错误日志").Add(User.Name & ":" & Date.Now  & vbcrlf & jsonString)
                Output.Logs("错误日志").Save("c:\log.txt",True)
                Output.Logs("错误日志").Clear
            else
                Dim dr As DataRow
                For Each obj As object In data.list
                    
                    dr = DataTables("图文群发每日数据").AddNew
                    'dr("操作日期") = obj.ref_date
                    dr("进入方式") = obj.user_source
                    dr("图文阅读人数") = obj.int_page_read_user
                    dr("图文阅读次数") = obj.int_page_read_count
                    dr("分享人数") = obj.share_user
                    dr("分享次数") = obj.share_count
                    dr("原文阅读次数") = obj.ori_page_read_user
                    dr("原文阅读人数") = obj.ori_page_read_count
                    dr("收藏人数") = obj.add_to_fav_user
                    dr("收藏次数") = obj.add_to_fav_count
                    dr("文章标题") = obj.title
                    dr("图文编号") = obj.msgid
                    
                    
                Next
                
            end if
            
            
        End Using
    End If
End Select

 回到顶部
帅哥哟,离线,有人找我吗?
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:超级版主 帖子:109387 积分:556591 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2016/11/23 20:38:00 [只看该作者]

......
If jsonString.Contains("errcode") Then
    Output.Logs("错误日志").Add(User.Name & ":" & Date.Now  & vbcrlf & jsonString)
    Output.Logs("错误日志").Save("c:\log.txt",True)
    Output.Logs("错误日志").Clear
Else
    Dim dr As DataRow
    Dim first As Boolean = True
    For Each obj As object In data.List
        If first Then
            dr = e.DataRow
            first = False
        Else
            dr = DataTables("图文群发每日数据").AddNew
        End If
        dr("操作日期") = e.NewValue
        dr("进入方式") = obj.user_source
        dr("图文阅读人数") = obj.int_page_read_user
        dr("图文阅读次数") = obj.int_page_read_count
        dr("分享人数") = obj.share_user
        dr("分享次数") = obj.share_count
        dr("原文阅读次数") = obj.ori_page_read_user
        dr("原文阅读人数") = obj.ori_page_read_count
        dr("收藏人数") = obj.add_to_fav_user
        dr("收藏次数") = obj.add_to_fav_count
        dr("文章标题") = obj.title
        dr("图文编号") = obj.msgid
        
        
    Next
    
End If
......
[此贴子已经被作者于2016/11/23 20:39:41编辑过]

 回到顶部