word文档中，按每段首行的文本为文件名，将word文档拆分并保存，vba代码怎么写？

zzpsx · 发表于 2024-3-31 11:49

本帖最后由 zzpsx 于 2024-3-31 11:50 编辑

word文档中，按每段首行的文本为文件名，将word文档拆分并保存到当前位置，vba代码怎么写？

word文档中，按每段首行的文本为文件名，将word文档拆分并保存到当前，vba代码怎么写？.zip (20.42 KB, 下载次数: 12)

蓝桥玄霜 · 发表于 2024-3-31 14:11

本帖最后由蓝桥玄霜于 2024-3-31 14:17 编辑

Sub lqxs_拆分()
Dim doc, i%, ss$, nm$, newDoc, ks%, js%
Set doc = ActiveDocument
ks = 0: js = 0
With doc
For i = 1 To .Paragraphs.Count
ss = .Paragraphs(i).Range
If Len(ss) <> 1 Then
If ks = 0 Then ks = i: nm = ss
Else
js = i - 1
Set newDoc = Documents.Add
.Range(Start:=.Paragraphs(ks).Range.Start, _
End:=.Paragraphs(js).Range.End).Copy
Selection.Paste
newDoc.SaveAs2 ThisDocument.Path & "" & Left(nm, Len(nm) - 1) & ".docx"
newDoc.Close -1
ks = 0: js = 0
End If
Next
End With
MsgBox "OK"
End Sub

复制代码

拆分的例子：

zzpsx · 发表于 2024-3-31 14:26

蓝桥玄霜发表于 2024-3-31 14:11
拆分的例子：

谢谢高手，代码运行结果显示

gwjkkkkk · 发表于 2024-3-31 15:46

本帖最后由 gwjkkkkk 于 2024-3-31 17:21 编辑

Option Explicit
Sub test()
Dim ar(), i&, j&, r&, iEnd&, strPath$

Application.ScreenUpdating = True
strPath = ThisDocument.Path & "\"
With ThisDocument.Content.Find
      .ClearFormatting
      .Forward = True
      .Text = "[0-9]{1,}月[0-9]{1,2}日"
      .MatchWildcards = True
      Do While .Execute
         .Parent.Select
         With Selection
            .MoveEndUntil Chr(13), wdForward
            r = r + 1
            ReDim Preserve ar(1 To 2, 1 To r)
            ar(1, r) = .Range.Text
            ar(2, r) = .Range.Start
         End With
      Loop
End With

If r Then
      With ThisDocument
         For j = 1 To UBound(ar, 2)
            If j = UBound(ar, 2) Then iEnd = .Range.End Else iEnd = ar(2, j + 1)
            .Range(ar(2, j), iEnd).Copy
            With Documents.Add
                  Selection.Paste
                  .SaveAs strPath & ar(1, j)
                  .Close
            End With
         Next j
      End With
End If

Application.ScreenUpdating = True
Beep
End Sub

gwjkkkkk · 发表于 2024-3-31 15:47

本帖最后由 gwjkkkkk 于 2024-3-31 17:08 编辑

参与一下。。。

wanghan519 · 发表于 2024-3-31 16:04

安利一下git for windows，有时候很方便

zzpsx · 发表于 2024-3-31 17:56

wanghan519 发表于 2024-3-31 16:04
安利一下git for windows，有时候很方便

这是什么神兵利器啊？

zzpsx · 发表于 2024-3-31 18:12

gwjkkkkk 发表于 2024-3-31 15:47
参与一下。。。

wanghan519 · 发表于 2024-3-31 18:14

zzpsx 发表于 2024-3-31 17:56
这是什么神兵利器啊？

git总是会用到的，装上不亏
git bash环境则是在批处理、文本方面有时会很方便
如果题目中是要拆分成多个docx还是vba更方便，拆分文本可以考虑批处理

gwjkkkkk · 发表于 2024-3-31 19:05

zzpsx 发表于 2024-3-31 18:12

我这里测试没问题啊，黄色地方改成 .Range(0).Paste 试试

		自动登录	找回密码
密码			免费注册

word文档中，按每段首行的文本为文件名，将word文档拆分并保存，vba代码怎么写？

评分

评分

评分

评分