- Foxtable(狐表) (http://foxtable.net/bbs/index.asp)
-- 专家坐堂 (http://foxtable.net/bbs/list.asp?boardid=2)
---- 求助：怎么实现表格数据准确标注呢？ (http://foxtable.net/bbs/dispbbs.asp?boardid=2&id=93251)
-- 发布时间：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
-- 发布时间：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编辑过]