使用VBA從Word中的特定列中選擇文本

Question

我有一個文檔，以分節符分隔。 在每個部分中，我可能有零個或一個分欄符。 我想從一個包含兩列，像這樣每個部分的第一列中提取文本：

For Each oSec In ActiveDocument.Sections 
    iSectionStart = oSec.Range.Start 
    iSectionEnd = oSec.Range.End 
    i = oSec.PageSetup.TextColumns.Count 
    If (2 = i) Then 
     ' Update the range to only contain the text in textcolumn 1 
     ' then select and copy it to a destination string 
    End If 
Next oSec 

然而，TextColumns對象似乎不具備返回列內容的方法。

Answer 1

TextColums.Count實際上不是由列中斷的數量指定的。您可以有2列（即TextColumns.Count = 2）沒有一個單獨的分欄符。

如果您例如創建一個新文檔，通過鍵入

=Rand(100)

與隨機文本填充它，並打從佈局選項卡輸入和選擇兩列。你會注意到，你會得到超過8頁左右的兩列，其中沒有任何頁面有列中斷。

Office對象模型沒有提供一個選項來自動選擇一節中特定頁面上的特定列。如果文檔實際上有分欄符，您可以使用「查找」選項來查找分欄符，然後從頁面的開始處選擇「範圍」，直到您剛剛使用「查找」選項找到的「分欄符」的開始位置。你可以看到，這不是一件小事。

Answer 2

由於分欄符標記由ASCII值14表示，所有我需要做的就是看看在部分的每個單詞，直到我找到了預期的標記

Sub ExtractColumnText() 
' 
' On pages with no columns, the text is copied to both output files 
' On pages with two columns, the column1 text is copied to "C:\DocTemp\Italian.doc" 
'       and column2 text is copied to "C:\DocTemp\English.doc" 
' 
Dim DestFileNum1 As Long 
Dim DestFileNum2 As Long 
Dim strDestFile1 As String 
Dim strDestFile2 As String 
Dim strCol1 As String 
Dim strCol2 As String 
Dim i As Integer 

Dim oSec As Section 
Dim oRngCol1 As Range 
Dim oRngCol2 As Range 
Dim oRngWord As Range 

strDestFile1 = "C:\DocTemp\Italian.doc" 'Location of external file 
DestFileNum1 = FreeFile() 
strDestFile2 = "C:\DocTemp\English.doc" 'Location of external file 
DestFileNum2 = DestFileNum1 + 1 
Open strDestFile1 For Output As DestFileNum1 
Open strDestFile2 For Output As DestFileNum2 

For Each oSec In ActiveDocument.Sections 
    Set rngWorking = oSec.Range.Duplicate 
    Set oRngCol1 = rngWorking.Duplicate 
    oRngCol1.End = rngWorking.End - 1 ' exclude the page break 
    Set oRngCol2 = oRngCol1.Duplicate 
    If 2 <= oSec.PageSetup.TextColumns.Count Then 
     'examine each word in the section until we switch columns 
     For Each rngWord In rngWorking.Words 
      ' 14 = column break marker 
      If 14 = AscW(rngWord.Text) Then    
       oRngCol1.End = rngWord.Start 
       oRngCol2.Start = rngWord.End 
       GoTo Xloop 
      End If 
     Next rngWord 
    End If 
Xloop: 
    oRngCol1.Select 
    Print #DestFileNum1, oRngCol1.Text 
    oRngCol2.Select 
    Print #DestFileNum2, oRngCol2.Text 
Next oSec 
Close #DestFileNum1 
Close #DestFileNum2 
MsgBox "Done!" 
End Sub