Foxtable(狐表)用户栏目专家坐堂 → [求助]表事件的自定义函数


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

主题:[求助]表事件的自定义函数

帅哥哟,离线,有人找我吗?
天一生水
  1楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


加好友 发短信
等级:五尾狐 帖子:1140 积分:11255 威望:0 精华:0 注册:2017/9/26 16:30:00
[求助]表事件的自定义函数  发帖心情 Post By:2021/1/1 13:59:00 [只看该作者]

老师好!

在窗口表里上传Word文档,将获取的文本内容保存至[笔录原文],文件路径保存至[上传笔录]。我想将此段代码改为自定义函数,不清楚要设置几个参数,请老师帮忙修改为函数代码,学习研究。

谢谢!

 


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

 

CellButtonClick代码:


Dim str As String = ""   '预设Word文本
Dim xwj As String = ""   '预设新文件名
Dim path As String = "D:\上传文件\开庭笔录\"    '指定新文件拷贝目录

If e.Col.Name = "上传笔录"  AndAlso e.Row("上传笔录") = "" Or e.Col.Name = "上传笔录"  AndAlso e.Row("上传笔录") = "请上传笔录" Then
    e.Cancel = True       '取消默认动作

    Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
    dlg.Filter= "Word文件|*.doc;*docx"        '设置筛选器
    If dlg.ShowDialog = DialogResult.Ok Then  '如果用户单击了确定按钮
        Dim ifo As new FileInfo(dlg.FileName)
        xwj = e.Row("案号") & "_开庭笔录_" & ".doc"        '文件改名
        FileSys.CopyFile(dlg.FileName, path & xwj,True)    '覆盖
        Dim app As New MSWord.Application
        Dim doc = app.Documents.Open(dlg.FileName)
        Dim rng As MSWord.Range = Doc.Range()
        str = rng.Text.replace(chr(13),vbcrlf)
        e.Row("笔录原文") = str
        app.quit
        e.Row("上传笔录") = path & xwj   '文档带路径
    End If
End If

 

********解决了,老师看看有没有问题?

 

' e :Args(0)
'e.Row:Args(1)
'e.Col:Args(2)
'"上传笔录":Args(3)
'"笔录原文":Args(4)

 

 

Dim str As String = ""   '预设Word文本
Dim xwj As String = ""   '预设新文件名
Dim path As String = "D:\上传文件\开庭笔录\"    '指定新文件拷贝目录

If Args(2).Name = Args(3)  AndAlso Args(1)(Args(3)) = "" Or Args(2).Name = Args(3)  AndAlso Args(1)(Args(3)) = "请上传笔录" Then
    Args(0).Cancel = True '取消默认动作

    Dim dlg As New OpenFileDialog '定义一个新的OpenFileDialog
    dlg.Filter= "Word文件|*.doc;*docx" '设置筛选器
    If dlg.ShowDialog = DialogResult.Ok Then '如果用户单击了确定按钮
        Dim ifo As new FileInfo(dlg.FileName)
        xwj = Args(1)("案号") & "_开庭笔录_" & ".doc"        '文件改名
        FileSys.CopyFile(dlg.FileName, path & xwj,True)   '覆盖
        Dim app As New MSWord.Application
        Dim doc = app.Documents.Open(dlg.FileName)
        Dim rng As MSWord.Range = Doc.Range()
        str = rng.Text.replace(chr(13),vbcrlf)
        Args(1)(Args(4)) = str
        app.quit
        Args(1)(Args(3)) = path & xwj   '文档带路径
    End If
End If

 

 

******函数调用:

Functions.Execute("aaa",e,e.Row,e.Col,"上传笔录","笔录原文")

 

 

 

 

 

 

 

 

 

 

 

 

 

 

 


 

[此贴子已经被作者于2021/1/1 18:03:49编辑过]

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


加好友 发短信
等级:超级版主 帖子:107896 积分:548849 威望:0 精华:9 注册:2015/6/24 9:21:00
  发帖心情 Post By:2021/1/3 9:40:00 [只看该作者]

测试呗,有问题再说

 回到顶部