Word (VBA)

Word VBAに関するフォーラムです。
  • 解決済みのトピックにはコメントできません。
このトピックは解決済みです。
質問

 
(Windows XP全般 : Word 2003)
表と表の間の行を削除して1つの表にすると列幅が変わる
投稿日時: 17/01/11 10:42:52
投稿者: nac

以下のように表と表の間に削除行を入れています。
  
表(列数6)
【削除行】
表(列数4)
【削除行】
表(列数8)
【削除行】
表(列数6)
  
これを以下のコードで
【削除行】を削除して1つの表にするのですが、
表の列幅が変わっていまします。
防ぐ方法がありましたら、教えてください。
列は固定値、表の全体ザイズも自動的に変わらない設定にしてあります。
  
Set rng = ActiveDocument.Range(0, 0)
With rng.Find
  .Text = "【削除行】 "
  .MatchWildcards = True
    Do While .Execute
    With rng
     .Paragraphs(1).Range.Delete
     .SetRange .End, .End
    End With
    Loop
End With

投稿日時: 17/01/11 17:04:07
投稿者: nac

以下の方法で解決しました。
表のすぐ上にある改行を削除することにより起こる現象だったようなので、
以下のように、表の上に新たな改行を入れて、それを削除して表同士を結合させました。
 
アイディアによる無理矢理の解決方法ですので、コード的に解決できる方法がありましたら、教えてください。
 
'-----------------
For i = 1 To ActiveDocument.Tables.Count
  ActiveDocument.Tables(i).Rows(1).Select
  Selection.InsertRowsAbove
  ActiveDocument.Tables(i).Rows(1).Cells(1).Range.InsertBefore "【削除2】"
Next
'-----------------
For i = ActiveDocument.Tables.Count To 1 Step -1
  ActiveDocument.Tables(i).Rows(1).Select
  Selection.Rows.ConvertToText Separator:=wdSeparateByTabs
Next
'-----------------
"【削除行】^13"
を削除
'-----------------
Set rng = ActiveDocument.Range(0, 0)
With rng.Find
  .Text = "【削除2】"
  .MatchWildcards = True
    Do While .Execute
    With rng
     .Paragraphs(1).Range.Delete
     .SetRange .End, .End
    End With
    Loop
End With

回答
投稿日時: 17/01/11 20:31:05
投稿者: miyakodai

Wordのマクロは全く分からないのでマクロを記録してみました。
何故これでいいのかよく分かりませんが私的には結果オーライでした。
私も識者のスマートな回答を知りたいところです。
 
表と表の間に「削除」を含む段落が一つあるものと仮定しています。
 
Sub 削除のある段落削除Macro1()
    Dim kosu As Variant
    Dim i As Long
    Selection.HomeKey Unit:=wdStory
    kosu = InputBox("削除を含む段落数は?")
    For i = 1 To kosu
        With Selection.Find
            .Text = "*削除*^13"
            .Replacement.Text = ""
            .Forward = True
            .Wrap = wdFindContinue
            .Format = False
            .MatchCase = False
            .MatchWholeWord = False
            .MatchByte = False
            .MatchAllWordForms = False
            .MatchSoundsLike = False
            .MatchFuzzy = False
            .MatchWildcards = True
        End With
        Selection.Find.Execute
        Selection.Delete Unit:=wdCharacter, Count:=1
        Selection.Delete Unit:=wdCharacter, Count:=1
    Next
End Sub

投稿日時: 17/01/12 09:37:05
投稿者: nac

miyakodaiさん
  
いろいろ試したのですが、1つの表を行ごとに分解したものを、まとめるという処理であれば、列幅は変わらないようです。
表によっては列幅の変わらないものもありました。
なので、表の前の改行が影響しているものと考え、
1:各表の1行目に行を追加
2:その行をテキスト変換
3:元々の削除行を削除
3:1〜2でつくった行を削除して表を結合
という処理にしました。

投稿日時: 17/01/12 16:52:31
投稿者: nac

ありがとうございました。閉じます。