Foxtable(狐表)用户栏目专家坐堂 → [求助]word vba代码怎样放到按钮的Click事件中


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

主题:[求助]word vba代码怎样放到按钮的Click事件中

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


加好友 发短信
等级:幼狐 帖子:124 积分:1196 威望:0 精华:0 注册:2015/12/27 21:01:00
[求助]word vba代码怎样放到按钮的Click事件中  发帖心情 Post By:2021/1/22 9:05:00 [只看该作者]

想在foxtable的按钮Click事件中加入如下VBA代码,需要怎样改动才能运行?
Sub demon()
Dim p As Paragraph, str1 As String, str2 As String
For Each p In ActiveDocument.Paragraphs
    str1 = Left(p.Range, 5)
    str2 = Left(p.Range, 4)
    If str1 = "【选择题】" Then
        A = p.Range.Start
    End If
    If str2 = "【解析】" Then
        B = p.Range.End
    Else
        GoTo 100
    End If
    ActiveDocument.Range(A + 6, B).Copy
    Documents.Add
    Selection.Paste
    Selection.TypeBackspace
    ActiveDocument.SaveAs2 "D:\练习\" & "x" & Left(ActiveDocument.Paragraphs(1), 1) & ".docx"
    ActiveDocument.SaveAs2 "D:\练习\" & "x" & Left(ActiveDocument.Paragraphs(1), 1), 10
    ActiveDocument.Close 0
    100
Next
End Sub
[此贴子已经被作者于2021/1/22 9:59:29编辑过]

 回到顶部
帅哥,在线噢!
有点蓝
  2楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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


Dim app As New MSWord.Application
try
    Dim fileName = "f:\123.docx"
    Dim doc = app.Documents.Open(fileName)
    '文档的处理
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try

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


加好友 发短信
等级:幼狐 帖子:124 积分:1196 威望:0 精华:0 注册:2015/12/27 21:01:00
  发帖心情 Post By:2021/1/22 9:39:00 [只看该作者]

进行如下改动后,单击按钮无法运行!不知道什么地方出现问题?

Dim app As New MSWord.Application
try
    Dim fileName = "D:\练习\选择题.docx"
    Dim doc = app.Documents.Open(fileName)
Dim p As MSword.Paragraph, str1 As String, str2 As String,A As Integer,B As Integer
For Each p In Doc.Paragraphs
    str1 = Left(p.Range, 5)
    str2 = Left(p.Range, 4)
    If str1 = "【选择题】" Then
        A = p.Range.Start
    End If
    If str2 = "【解析】" Then
        B = p.Range.End
    Else
        GoTo 100
    End If
    Doc.Range(A + 6, B).Copy
    app.Documents.Add
    doc.Selection.Paste
    doc.Selection.TypeBackspace
    doc.SaveAs2("D:\练习\" & "x" & Left(doc.Paragraphs(1), 1) & ".docx")
    doc.SaveAs2("D:\练习\" & "x" & Left(doc.Paragraphs(1), 1), 10)
    doc.Close(0)
    100:
Next
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try

 回到顶部
帅哥,在线噢!
有点蓝
  4楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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

文档发上来,说明要做什么功能?

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


加好友 发短信
等级:幼狐 帖子:124 积分:1196 威望:0 精华:0 注册:2015/12/27 21:01:00
  发帖心情 Post By:2021/1/22 10:03:00 [只看该作者]

 下载信息  [文件大小:   下载次数: ]
图片点击可在新窗口打开查看点击浏览该文件:练习.rar

将练习文件夹下的选择题文档中的习题进行拆分后分别保存,形成独立docx和pdf文档。文件名以题号命名。
拆分后的文档已经存在于该文件夹内。
[此贴子已经被作者于2021/1/22 10:04:25编辑过]

 回到顶部
帅哥,在线噢!
有点蓝
  6楼 | 信息 | 搜索 | 邮箱 | 主页 | UC


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

Dim app As New MSWord.Application
try
    Dim fileName = "D:\问题\练习\选择题.docx"
    Dim doc = app.Documents.Open(fileName)
    Dim p As MSword.Paragraph, str1 As String, str2 As String,A As Integer,B As Integer
    For Each p In Doc.Paragraphs
        str1 = Left(p.Range.Text.ToString(), 5)
        str2 = Left(p.Range.Text.ToString(), 4)
        If str1 = "【选择题】" Then
            A = p.Range.Start
        ElseIf str2 = "【解析】" Then
            B = p.Range.End
            Doc.Range(A + 6, B).Copy
            Dim d2  = app.Documents.Add
            app.Selection.Paste
            app.Selection.TypeBackspace
            d2.SaveAs2("D:\问题\练习\x" & Left(d2.Paragraphs(1).Range.Text.ToString, 1) & ".docx")
            d2.Close(0)
        End If
    Next
catch ex As exception
    msgbox(ex.message)
finally
    app.Quit
End try

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


加好友 发短信
等级:幼狐 帖子:124 积分:1196 威望:0 精华:0 注册:2015/12/27 21:01:00
  发帖心情 Post By:2021/1/22 12:08:00 [只看该作者]

谢谢老师的指导,程序已经能运行,效果完全符合要求!!!

 回到顶部