使用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
我在使用 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