2016-09-27 7 views
0

セクション区切りで区切られたドキュメントがあります。 各セクションには、ゼロまたは1つの列区切りがあります。 私はそうのように、2列が含まれている各セクションの最初の列からテキストを抽出したい:VBAでWordの特定の列からテキストを選択

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は、列の内容を返すためのメソッドを持っていないようですオブジェクト。

答えて

0

TextColums.Countは、実際には列区切りの数で指定されていません。 1つの列区切りなしで2つの列(TextColumns.Count = 2)を使用できます。

あなたは、例えば、新しいドキュメントを作成

=Rand(100)

を入力して、ランダムなテキストとそれを記入し、[レイアウト]タブから2つの列を入力して選択しヒットした場合。あなたは8ページ以上に2つのカラムがあることに気づくでしょう。

Officeオブジェクトモデルには、セクション内の特定ページの特定の列を自動的に選択するオプションはありません。ドキュメントに実際に列区切りがある場合は、[検索]オプションを使用して列区切りを検索し、ページの先頭から[検索]オプションを使用して見つかったばかりの列区切り文字の開始までの範囲を選択できます。あなたが見ることができるほど簡単なことではありません。

+0

を見つけるまでのセクションで各単語を見ていました! – pnswdv

+0

しかし、私があなたが記述するカラム・ブレークのあいまい性について心配する必要はありません。ドラフトモードで表示されている場合、ソースドキュメントの書式はLanguage1 + ColumnBreak + Language2 + SectionBreakになります。 – pnswdv

0

列の区切りマーカーが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 
関連する問題