2017年10月25日（追記） 改良版をアップしました。 【コード】表中の結合されたセルを着色するWordマクロ（その２） ←バグあり 【コード】表中の結合されたセルを着色するWordマクロ（その３） ←改良版
前回の記事「【Wordマクロ】表中の結合・分割セルの有無を判定する 」にて、結合・分割のセルの有無を判定しましたが、今回の記事では、どのセルが結合しているのかを判定します。
＜目次＞
このマクロでできること
表のセルが結合しているかどうかを判定し、結合している場合にセルの背景を黄色に着色します。
下図のとおり、入れ子構造（ネスト）のセルの結合状態については判定しません。
マクロの解説
Wordのセルには結合を判定するプロパティがないため、判定方法を工夫しています。
この判定には、Microsoft MVP for Office System のきぬあささん の「すべてのテーブルの結合を解除するWordマクロ 」を参考にさせていただきました。技ありの判定方法です。
縦方向の結合は、Selection オブジェクトのInformation プロパティから判定しています（20～21行目）。
さらに、横方向の結合は、xmlの情報を取得して判定しています（44～60行目）。
マクロ
Sub セルの結合を判定する()
Dim myTable As Table
Dim myCell As Cell
Dim rowSpan As Long
Dim myDoc As Document
Dim blnMerged As Boolean
Set myDoc = ActiveDocument
For Each myTable In myDoc.Tables
For Each myCell In myTable.Range.Cells
myCell.Select
With Selection
'縦方向の結合の判定
rowSpan = (.Information(wdEndOfRangeRowNumber) - _
.Information(wdStartOfRangeRowNumber)) + 1
If rowSpan <> 1 Then
blnMerged = True
Else
'横方向の結合の判定
With myCell
blnMerged = IsMergedCell(myTable, .RowIndex, .ColumnIndex)
End With
End If
End With
If blnMerged = True Then
myCell.Range.Shading.BackgroundPatternColorIndex = wdYellow
End If
Next myCell
Next myTable
End Sub
Function IsMergedCell(myTable As Table, i As Long, n As Long) As Boolean
Dim myXML As Object
i = i - 1
n = n - 1
IsMergedCell = False
Set myXML = CreateObject("MSXML2.DOMDocument")
If myXML.LoadXML(myTable.Range.XML) Then
With myXML.SelectNodes("/w:wordDocument/w:body/wx:sect/w:tbl/w:tr")
With .Item(i).SelectNodes("w:tc")
If .Item(n).SelectNodes("w:tcPr/w:gridSpan").Length > 0 Then
IsMergedCell = True
End If
End With
End With
End If
End Function
関連記事
すべてのテーブルの結合を解除するWordマクロ (きぬあささんの記事）
ちなみにいくつかの記事を読みましたが、これらの記事では判定は難しいとされています。
きぬあささんの技に感謝！
How do I detect a Word table with (horizontally) merged cells?
Check for merged cells with VBA
コメント
-
2. Re:Re:【Wordマクロ】表中の結合されたセルを着色する
＞kinuasaさん
コメントをありがとうございます。
この記事には助けられました！こういうプロパティ追加してほしいですよね。
