使用vba TextColumns 方法将word文档的一部分拆分为两栏时,会影响整个文档

When using vba TextColumns method to split two column a part of a word document, it will affect the entire document

我在使用 vba 进行列操作时遇到问题。

我想selectword文档中包含多个段落的区域,然后我想将它们从一栏分成两栏。

我的vba代码如下:

Public Sub testSplitColumn()
    Dim targetDoc As Document
    Dim sourceFileName As String
    
    sourceFileName = "file path"
    Set targetDoc = Documents.Open(sourceFileName, , True)
    targetDoc.Paragraphs(503).range.Select

    'Splitting column on word
    With targetDoc.Paragraphs(503).range.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
    End With
End Sub

可以运行,但是结果不对

它将对整个文档中的段落进行分栏,而不仅仅是代码中 selected 的段落。

我通过word宏录制的方法得到了一个可以达到正确效果的宏代码:

Sub split()
    If ActiveWindow.View.SplitSpecial <> wdPaneNone Then
        ActiveWindow.Panes(2).Close
    End If
    If ActiveWindow.ActivePane.View.Type <> wdPrintView Then
        ActiveWindow.ActivePane.View.Type = wdPrintView
    End If
    With Selection.PageSetup.TextColumns
        .SetCount NumColumns:=2
        .EvenlySpaced = True
        .LineBetween = False
    End With
End Sub

不过和我的没什么区别

我现在很迷茫,不知道该怎么办,希望大家能帮帮我。

正如@JerryJeremiah 所说:您需要在选择前后分节。 录制宏时 - 它们也会被插入。

我会创建一个通用的 sub 来插入分节符:


Public Sub test_splitTo2Columns()

'your original code
Dim targetDoc As Document
Dim sourceFileName As String

sourceFileName = "file path"
Set targetDoc = Documents.Open(sourceFileName, , True)

'calling the generic function to test with specific paragraph
splitTo2Columns targetDoc.Paragraphs(503).Range

'this will work too - splitting the selected range
splitTo2Columns ActiveDocument.Selection.Range

End Sub


Public Sub splitTo2Columns(rg As Range, Optional fSplitWholeParagraphs As Boolean = True)

Dim rgToSplit As Range
Set rgToSplit = rg.Duplicate

If fSplitWholeParagraphs = True Then
    'in case rg = selection and selection is only a single character
    rgToSplit.Start = rgToSplit.Paragraphs.First.Range.Start
    rgToSplit.End = rgToSplit.Paragraphs.Last.Range.End
End If

insertSectionBreakContinous rgToSplit, wdCollapseStart
insertSectionBreakContinous rgToSplit, wdCollapseEnd

rgToSplit.Start = rgToSplit.Start + 1   'move behind first section break
With rg.PageSetup.TextColumns
    .SetCount NumColumns:=2
    .EvenlySpaced = True
    .LineBetween = False
End With

End Sub

Private Sub insertSectionBreakContinous(rg As Range, startEnd As WdCollapseDirection)
Dim rgBreak As Range
Set rgBreak = rg.Duplicate
With rgBreak
    .Collapse startEnd
    .InsertBreak wdSectionBreakContinuous
End With
End Sub