拆分 | ExcelOffice【微信公众号：水星Excel】

Sub QQ1722187970()
    Const wdReplaceAll = 2
    Dim oRng As Range
    Dim oRng1 As Range
    Dim oRngT As Range
    Dim oDoc As Document
    Set oDoc = Word.ActiveDocument
    Dim oDoc1 As Document
    sPath = oDoc.Path
    Set oRng = Word.Selection.Range
    '先判断是否有选中区域，没有选中则表示整个文档
    If oRng.Start = oRng.End Then
        Set oRng = Word.ActiveDocument.Content
    End If
    '获取要执行操作的区域的起点和终点，用于查找替换时判断是否超出了选定区域
    iStart = oRng.Start
    iEnd = oRng.End
'    Debug.Print oRng.Text
    Set oRng1 = oRng
    With oRng1.Find
        i = 1
        j = 0
        .ClearFormatting
        .MatchWildcards = False
        .Text = "^m"
        '每执行一次查找，只要找到了结果，oRng对象会自动变成被找到的内容所在的区域
        Do Until .Execute() = False Or oRng1.Start > iEnd Or oRng1.End < iStart
            
            Set oDoc1 = Word.Documents.Add
            
            k = oRng1.Start
            Set oRngT = oDoc.Range(j, k)
            oRngT.Copy
            oDoc1.Content.Paste
            j = k + 1
            oDoc1.SaveAs2 sPath & "\" & i & ".doc"
            oDoc1.Close
            i = i + 1
        Loop
    End With
    Set oDoc1 = Word.Documents.Add
    k = oDoc.Content.End
    Set oRngT = oDoc.Range(j, k)
    oRngT.Copy
    oDoc1.Content.Paste
    oDoc1.SaveAs2 sPath & "\" & i & ".doc"
    oDoc1.Close
End Sub

1

2

3

4

5

6

7

8

9

10

11

12

13

14

15

16

17

18

19

20

21

22

23

24

25

26

27

28

29

30

31

32

33

34

35

36

37

38

39

40

41

42

43

44

45

46

47

48

Sub QQ1722187970()

Const wdReplaceAll = 2

Dim oRng As Range

Dim oRng1 As Range

Dim oRngT As Range

Dim oDoc As Document

Set oDoc = Word.ActiveDocument

Dim oDoc1 As Document

sPath = oDoc.Path

Set oRng = Word.Selection.Range

'先判断是否有选中区域，没有选中则表示整个文档

If oRng.Start = oRng.End Then

Set oRng = Word.ActiveDocument.Content

End If

'获取要执行操作的区域的起点和终点，用于查找替换时判断是否超出了选定区域

iStart = oRng.Start

iEnd = oRng.End

' Debug.Print oRng.Text

Set oRng1 = oRng

With oRng1.Find

i = 1

j = 0

.ClearFormatting

.MatchWildcards = False

.Text = "^m"

'每执行一次查找，只要找到了结果，oRng对象会自动变成被找到的内容所在的区域

Do Until .Execute() = False Or oRng1.Start > iEnd Or oRng1.End < iStart

Set oDoc1 = Word.Documents.Add

k = oRng1.Start

Set oRngT = oDoc.Range(j, k)

oRngT.Copy

oDoc1.Content.Paste

j = k + 1

oDoc1.SaveAs2 sPath & "\" & i & ".doc"

oDoc1.Close

i = i + 1

Loop

End With

Set oDoc1 = Word.Documents.Add

k = oDoc.Content.End

Set oRngT = oDoc.Range(j, k)

oRngT.Copy

oDoc1.Content.Paste

oDoc1.SaveAs2 sPath & "\" & i & ".doc"

oDoc1.Close

End Sub

[……]

阅读全文>>>

如何用vba冻结拆分窗格？

2016年11月3日作者：水星Excel

1,470 次浏览暂无评论

冻结拆分窗格可以使表格的标题行在滚动滚轮时始终保持在最前面。这个功能是经常被使用的excel功能。

在vba中可以使用Window对象的SplitRow和SplitColumn属性进行窗格的拆分，设置F[……]

阅读全文>>>

如何在C#中实现字符串split拆分成数组的功能？

如何用vba拆分word表格的单元格？

其它软件带分隔符的多行文本如何快速转换成Excel的一列？

如何在excel中用函数公式将单元格内容按照固定的分隔符分列?

如何在ppt中用vba实现图形的布尔运算？

如何写vba根据任意选择的字段名拆分工作表数据？

如何用vba将多个工作表另存为独立的工作簿文件？

如何用vba将word文档按照手动分页符拆分？

如何用vba冻结拆分窗格？

感谢你的支持，我将持续地写出更好的文章。

热门文章

最近文章

微信公众号