- Foxtable(狐表) (http://foxtable.com/bbs/index.asp)
-- 专家坐堂 (http://foxtable.com/bbs/list.asp?boardid=2)
---- [求助]word vba代码怎样放到按钮的Click事件中 (http://foxtable.com/bbs/dispbbs.asp?boardid=2&id=160135)
-- 发布时间：2021/1/22 9:05:00
-- [求助]word vba代码怎样放到按钮的Click事件中
想在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编辑过]
-- 发布时间：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
-- 发布时间：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
-- 发布时间：2021/1/22 9:59:00
--
文档发上来，说明要做什么功能？
-- 发布时间：2021/1/22 10:03:00
--
| 下载信息 [文件大小： 下载次数： ] | |
 点击浏览该文件:练习.rar |
将练习文件夹下的选择题文档中的习题进行拆分后分别保存，形成独立docx和pdf文档。文件名以题号命名。
拆分后的文档已经存在于该文件夹内。
[此贴子已经被作者于2021/1/22 10:04:25编辑过]
-- 发布时间：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
-- 发布时间：2021/1/22 12:08:00
--
谢谢老师的指导，程序已经能运行，效果完全符合要求！！！