Word VBA質問箱 IV

当質問箱は、有志のボランティア精神のおかげで成り立っています。
問題が解決したら、必ずお礼をしましょうね。
本サイトの基本方針をまとめました。こちらをご一読ください。

投稿種別の選択が必要です。ご注意ください。
迷惑投稿防止のため、URLの入力を制限しています。ご了承ください。


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

5 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【838】Re:各ページ各行それぞれ違う文字列の挿入

あかよん - 18/2/9(金) 12:47 -


	引用なし

	パスワード

>各ページは1～10行目になんらかの文字列があり、続いて参照する項目があればそれが入る。その後、改行記号の連打ではなく空白（つまり改ページが入っている）ということでいいでしょうか。

はい。その通りです。
私はマクロの記録をちょっと手直しをしたことがあるくらいで、簡単なコードを理解するのも難しいレベルです。数百ページあり、必要に迫られてしまいまして、質問も拙いものばかりで大変お手数をおかけして申し訳ありません。

>１．カーソルを次の行に移動
>２．現在のカーソルが1行目かどうかを判定
>３．1行目なら先ほどの行が最終行だったということなので、前の行に戻る
>　　1行目でなければ1行目になるまで１．～２．を繰り返す
>４．現在の行（最終行）の末尾にカーソルを移動
>５．改行
>６．挿入したい文章を加える

　この3番目がどこにどのように繰り返しの記述を入れたらよいのか、どうしてもわかりません。よろしくお願いいたします。

Dim tempLine As Long
Dim tempColumn As Long

tempLine = Selection.Information(wdFirstCharacterLineNumber)
tempColumn = Selection.Information(wdFirstCharacterColumnNumber)

Selection.Move wdLine, 1　　　　　

Select Case Selection.Information(wdFirstCharacterLineNumber)
　　Case 1 '1行目の時
　　　　Selection.MoveUp Unit:=wdLine, Count:=1
　　　　Selection.EndKey Unit:=wdLine
　　　　Selection.TypeParagraph
　　　　Selection.TypeText Text:="</item>"
　　
　　Case tempLine　'最終ページの最終行の時
　　　　Selection.EndKey Unit:=wdLine
　　　　Selection.TypeParagraph
　　　　Selection.TypeText Text:="</item>"
　　
　　Case Else
　　　　
　　　　　　　　？？？？　　
　　　　
End Select

・ツリー全体表示


	【837】Re:各ページ各行それぞれ違う文字列の挿入

亀マスター - 18/2/7(水) 21:38 -


	引用なし

	パスワード

>データの空白行に改行記号がついていないので、ページの最終行にカーソルを置いて次の行へ移動すると次ページの1行目になります。（2番の「次の行へ移動」させた後にMsgBoxで行を表示させてみたら、やはり１でした。）

各ページは1～10行目になんらかの文字列があり、続いて参照する項目があればそれが入る。その後、改行記号の連打ではなく空白（つまり改ページが入っている）ということでいいでしょうか。

>　それから、最終行でなかった場合の処理というのは
>1行下の列に移動して、また1番から繰り返すということでしょうか。（ページ毎のループに入れてよいのでしょうか？）

私が示したコードは、今現在カーソルのある位置が最終行かどうかを判定するだけのものですので、現在の最終行の下に何か1行を加えるという目的であれば、少し手順を変えた方がいいかもですね。（基本的な考え方は同じです）

１．カーソルを次の行に移動
２．現在のカーソルが1行目かどうかを判定
３．1行目なら先ほどの行が最終行だったということなので、前の行に戻る
　　1行目でなければ1行目になるまで１．～２．を繰り返す
４．現在の行（最終行）の末尾にカーソルを移動
５．改行
６．挿入したい文章を加える

という感じですか。

>試しに1ページ目の最終行にカーソルを置いてこのコードを実行させると、1ページ目の次ページの1行目に挿入されました。

このコードというのがどういうものかわかりませんので、現在のコードの全体を示してもらえると助かります。

・ツリー全体表示


	【836】Re:各ページ各行それぞれ違う文字列の挿入

あかよん - 18/2/7(水) 14:03 -


	引用なし

	パスワード

ページの最終行を直接判定する方法はないのですね。
具体的に考え方やコードを教えてくださいまして、ありがとうございます。

　これは、データの空白行に改行記号がついていなくてもできますか？
データの空白行に改行記号がついていないので、ページの最終行にカーソルを置いて次の行へ移動すると次ページの1行目になります。（2番の「次の行へ移動」させた後にMsgBoxで行を表示させてみたら、やはり１でした。）試しに1ページ目の最終行にカーソルを置いてこのコードを実行させると、1ページ目の次ページの1行目に挿入されました。

　それから、最終行でなかった場合の処理というのは
1行下の列に移動して、また1番から繰り返すということでしょうか。（ページ毎のループに入れてよいのでしょうか？）

・ツリー全体表示


	【835】Re:各ページ各行それぞれ違う文字列の挿入

亀マスター - 18/2/6(火) 19:41 -


	引用なし

	パスワード

カーソル位置がページ最終行かどうかについては、それを直接判定する方法はないようです（私ではわからない＆探しても見つけられなかった）

ですので、私ならどうするかですが、

１．現在のカーソル位置が何行目の何文字目かを記録
２．カーソルを次の行へ移動（最終ページの場合は動かない）
３．移動前と移動後の行番号を比較して、移動後の方が大きければ（同じページ内の次の行に移動している）最終行でない、同じか小さければ最終行と判定
４．元の位置にカーソルを戻す

という感じです。

何行目、何文字目というのは、
Selection.Information(wdFirstCharacterLineNumber)
Selection.Information(wdFirstCharacterColumnNumber)
で取得できます。

具体的なコードですが、こんなものでどうでしょう。

Dim tempLine As Long
Dim tempColumn As Long

tempLine = Selection.Information(wdFirstCharacterLineNumber)
tempColumn = Selection.Information(wdFirstCharacterColumnNumber)

Selection.Move wdLine, 1

Select Case Selection.Information(wdFirstCharacterLineNumber)
　　Case Is < tempLine
　　　　Selection.Move wdLine, -1
　　　　Selection.Move wdCharacter, tempColumn - 1
　　　　※最終行だった場合の処理※
　　Case tempLine
　　　　Selection.HomeKey
　　　　Selection.Move wdCharacter, tempColumn - 1
　　　　※最終行だった場合の処理※
　　Case Else
　　　　Selection.Move wdLine, -1
　　　　Selection.Move wdCharacter, tempColumn - 1
　　　　※最終行でなかった場合の処理※
End Select

・ツリー全体表示


	【834】前面で配置した図のアンカーの移動

はな - 18/2/6(火) 16:24 -


	引用なし

	パスワード

図から離れた位置に移動させたアンカーを、図と同じ段落に移動することは可能でしょうか。

図をマウスで移動した場合、アンカーが図と同じ段落に移動されます。
それと同じことをVBAで行いたいのですが、
VBAで図を移動してもアンカーはもとの位置のままです。。。

ご教示お願いいたします。

・ツリー全体表示


	【833】Re:各ページ各行それぞれ違う文字列の挿入

あかよん - 18/2/6(火) 11:14 -


	引用なし

	パスワード

　数百ページあり必要に迫られていましたので、大変助かりました。基本的なことが理解できないままの質問に親切ご丁寧にお答えくださり、どうもありがとうございました。まだテストの段階ではありますが、教えていただいた通りに変更をして各ページ各行の前後の文字列の挿入はなんとかできました。

　もう一つ教えていただきたいことがあります。各ページの最後には参照する項目が追加されました。参照するものがない場合は何も記述されていませんが、参照する項目がある場合は、1件だったら1行、3件だったら3行記述されています。各ページの最終行の1行下に文字列を挿入したいのですが、ページの最終行というのはどのように判断するのでしょうか。

・ツリー全体表示


	【832】Re:各ページ各行それぞれ違う文字列の挿入

亀マスター - 18/2/5(月) 13:19 -


	引用なし

	パスワード

> Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=1

無限ループしている直接の原因はこれでしょう。
これはカーソルを1ページ目へ移動する記述ですので、ループ処理の中でこれを使えば、いつも1ページ目しか処理されず、ループも終わらなくなりますね。

あと、その部分を削ったとしても今のままでは各ページの1行目だけに文字が挿入され、2行目以降が処理されなくなるように思えます。

文字を挿入する部分は、以下のように考えてみてください。
それぞれの処理の記述の仕方がわからなければ、再質問してください。

Do
　　Selection.EndKey Unit:=wdLine, Extend:=wdExtend
　　Selection.MoveEndWhile Cset:=myExcludes, Count:=wdBackward

　　'ループの中でmyText1とmyText2の内容を変更できるように工夫が必要
　　With Selection
　　　　.InsertBefore myText1
　　　　.InsertAfter myText2
　　End With

　　'もし10行目まで処理を終えていればループを抜ける
　　If （10行目まで終わっている）
　　　　（ループを抜ける）
　　'まだ10行目になってなければカーソルを次の行に移動する
　　Else
　　　　（カーソルを次の行に移動）
　　End If

Loop

ちなみに、

> Dim doc As Word.Document
> Set doc = Application.ActiveDocument

> Dim myDoc As Document
> Dim myRange As Range
> Set myDoc = ActiveDocument
> With Selection
>　 Set myRange = myDoc.Range(.End - Len(myText2), .End)
> End With
> Set myRange = Nothing
> Set myDoc = Nothing

これらは完全に不要な記述ですね。実質的に何も処理していないので。
複数の処理について参考サイトからコピーしてきたのだと思われますが、あなたがやろうとしていることには必要ありませんよ。

> myExcludes

一見すると、変数の定義がされていないようです。
バグの元になるので、
Dim last_page As Long
などと並べて
Dim myExcludes As String
と記述しておいた方がいいですよ。

> Const myText1 As String = "<item id=""" '前の文字列"
> Const myText2 As String = """>" '後の文字列

間違いではないのですが、普通、変数や定数の宣言はコードの最初にしてしまいます。
Dim last_page As Long
などと並べて記述しておいた方がいいですよ。

> myExcludes = Chr(9) & Chr(10) & Chr(11) & Chr(12) & Chr(13)

ループ処理の中に記述すると、何度も同じ処理をすることになるので（今回の場合大した問題ではないですが）、ループに入る前に記述しましょう。

・ツリー全体表示


	【831】Re:各ページ各行それぞれ違う文字列の挿入

あかよん - 18/2/5(月) 9:30 -


	引用なし

	パスワード

ご回答ありがとうございます。
とりあえず、＊のところに1行目の前後に挿入する記述を書いて、テストをしてみました。＊のところに記述したのは以下の通りです。それから、1ページ目だけに関しては、2行目以降はmytextの数字を変えただけでそのままコピペしてこの記述の繰り返しでできましたが、それでよいのでしょうか？

Selection.GoTo What:=wdGoToPage, Which:=wdGoToFirst, Count:=1
　　myExcludes = Chr(9) & Chr(10) & Chr(11) & Chr(12) & Chr(13)

　　Selection.EndKey Unit:=wdLine, Extend:=wdExtend
　　Selection.MoveEndWhile Cset:=myExcludes, Count:=wdBackward
　
　Dim myDoc As Document
　Dim myRange As Range

　Const myText1 As String = "<item id=""" '前の文字列"
　Const myText2 As String = """>" '後の文字列

　Set myDoc = ActiveDocument

　With Selection
　　.InsertBefore myText1
　　.InsertAfter myText2
　End With

　With Selection
　　Set myRange = myDoc.Range(.End - Len(myText2), .End)
　End With

　Selection.Collapse wdCollapseEnd

　Set myRange = Nothing
　Set myDoc = Nothing
　　　
　Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1

・ツリー全体表示


	【830】Re:各ページ各行それぞれ違う文字列の挿入

亀マスター - 18/2/2(金) 23:06 -


	引用なし

	パスワード

手元で適当に1ページあたり10行のテキストがある文書で　＊ここにそれぞれの行に文字列を挿入する記述をする＊　以外の部分をコピーして実行してみましたが、無限ループにはなりませんでした。
＊ここにそれぞれの行に文字列を挿入する記述をする＊　の中でループ処理をしていて、そこで無限ループしているのではないでしょうか？
よろしければ、該当の部分のコードを示してもらえればアドバイスできるかもしれません。（書き込む内容を人に見せたくないのであれば、適当に別の言葉に変更してもいいです）

・ツリー全体表示


	【829】各ページ各行それぞれ違う文字列の挿入

あかよん - 18/2/2(金) 10:58 -


	引用なし

	パスワード

初心者です。
　1ページに10行あり、各ページの1行目の行頭、行末、2行目の行頭、行末・・・１０行目までそれぞれ違う文字列を挿入したいです。

　まず、行頭、行末に文字列を挿入する方法がわからず、選択範囲の前後に文字列を挿入するというマクロがあったので参照して、なんとか１ページのみ１行目から１０行目までそれぞれの文字列を挿入をすることはできましたが、各ページで同じ作業をするために、ページ毎の繰り返しというマクロをそのまま参照して以下のように記述したところ、文字列を挿入し続けて無限ループに入ってしまいました。どこを直したらよいのか教えてください。よろしくお願いいたします。

　Dim last_page As Long
　Dim active_page As Long
　Dim doc As Word.Document
　
　Set doc = Application.ActiveDocument
　Selection.HomeKey Unit:=wdStory
　last_page = Selection.Information(wdNumberOfPagesInDocument)
　Do Until active_page = last_page
　　active_page = Selection.Information(wdActiveEndPageNumber)

　＊ここにそれぞれの行に文字列を挿入する記述をする＊

　 Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Count:=1
　Loop
　Selection.HomeKey Unit:=wdStory

・ツリー全体表示


	【828】Re:置換すると字下げが崩れる

りった - 17/11/28(火) 9:30 -


	引用なし

	パスワード

回答ありがとうございます。やってみます。

・ツリー全体表示


	【827】Re:置換すると字下げが崩れる

マナ - 17/11/27(月) 20:44 -


	引用なし

	パスワード

▼りったさん：

１）こんな感じで。

Option Explicit

Sub test()
　　Dim r As Range
　　
　　Set r = ActiveDocument.Content

　　With r.Find
　　　　.Text = "キーワード"
　　　　If .Execute Then r.Text = "aaa" & vbCr & "bbb"
　　End With

End Sub

２）検索でなく、ブックマークの利用もできます。

Sub test2()
　　Dim doc As Document
　　
　　Set doc = ActiveDocument
　　
　　 doc.Bookmarks("キーワード").Range.Text = "aaa" & vbCr & "bbb"
　　
End Sub

・ツリー全体表示


	【826】置換すると字下げが崩れる

りった - 17/11/27(月) 12:40 -


	引用なし

	パスワード

印刷するフォームがWordです。
そこに埋めるべきデータがExcelに入ってます。
Excelからの操作で、値が埋め込まれたWord文書を作りたいです。(最終ゴール)
第一ステップとして、Wordのフォームの値埋め込み個所にキーワードをあらかじめ記載しておき、Wordマクロ(※)で置換してみました。
置換操作を「マクロの記録」し、ReplacementをvbCrLfで繋げた文字列にしたところ、2行目の字下げがされませんでした。(2行目以降のインデントがゼロになってる感じ)
尚、行数が不定なので、一行ずつ置換するのは無理です。
どうやったらマクロから、適切な位置に複数行を入力することが出来ますか？
(置換作戦にはこだわってません)

私の知識：
・Wordの知識はほとんどありません。
・Excelマクロの知識はそれなりに有ります。

※ Excel→Wordでマクロを呼び出す方法については調査未。まずはWordマクロで実験。

・ツリー全体表示


	【825】Re:蛍光ペンの置き換えが表内で止まる

マナ - 17/8/9(水) 19:45 -


	引用なし

	パスワード

▼ぱたぱたさん：

解決後ですが、

１)今のコードを修正するなら、次の検索に移る前に
以下を実行すると問題は解決すると思います。
置換マクロではよく使われる手法です。

Selection.Collapse direction:=wdCollapseEnd

また、今のコードはマクロ実行前のカーソルの位置で結果がかわります。
最初にカーソルを文頭に移動させたほうがよいです。

Selection.HomeKey wdStory

２）Rangeオブジェクトを使用する場合でも
無限ループになる場合があります。

なので、同じように、
Rng.Collapse direction:=wdCollapseEnd

を追加しておいたほうが無難かもしれません。

３）色が違う蛍光ペンが連続してあると置換に失敗するそうです。

ht　tp://ameblo.jp/gidgeerock/entry-11012321922.html

以上を踏まえて、わたしの場合はこんな感じにします。

Option Explicit

Sub test()
　　Dim r As Range
　　
　　Set r = ActiveDocument.Range
　　
　　With r.Find
　　　　.Format = True
　　　　.Highlight = True
　　　　Do While .Execute
　　　　　　Do While r.HighlightColorIndex = wdUndefined
　　　　　　　　r.MoveEnd Unit:=wdCharacter, Count:=-1
　　　　　　Loop
　　　　　　If r.HighlightColorIndex = wdBrightGreen Then
　　　　　　　　r.HighlightColorIndex = wdTurquoise
　　　　　　End If
　　　　　　r.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With

End Sub

・ツリー全体表示


	【824】Re:蛍光ペンの置き換えが表内で止まる

ぱたぱた - 17/8/2(水) 12:33 -


	引用なし

	パスワード

亀マスター様

ありがとうございます！
Selectionを使用していたせいで無限ループになっていたのですね。
コード例に挙げていただいたようにRangeを使用したら表内も無事、蛍光ペンの色を置き換えることができました。

テーブル以外だけを対象にするコードまで教えてくださりありがとうございます。
本当に勉強になりました。

いろいろと詳細に説明いただきありがとうございました。

・ツリー全体表示


	【823】Re:蛍光ペンの置き換えが表内で止まる

亀マスター - 17/8/1(火) 20:20 -


	引用なし

	パスワード

Findを使う際にSelectionを使ったため、1個目の置換後に
カーソル位置（Selection）が置換した範囲の左側に移り、
そこで次の検索を実行するとまた同じものがヒットして・・・
という感じで無限ループになったのだと思われます。

そこで、SelectionではなくRangeオブジェクトのFindを
使うことで解決できると思います。

Sub コード例()

Dim Rng As Range

'Rngの位置を文書の先頭にRangeにセット
Set Rng = ActiveDocument.Range(0, 0)

With Rng.Find
　　.ClearFormatting
　　.Format = True
　　.Highlight = True
　　.Text = ""
　　Do
　　　　If Not .Execute Then Exit Do
　　　　'テーブル以外だけを対象（テーブル内も置換したいならここのIfは不要）
　　　　If Not Rng.Information(wdWithInTable) Then
　　　　　　If Rng.HighlightColorIndex = wdBrightGreen Then
　　　　　　　　Rng.HighlightColorIndex = wdTurquoise
　　　　　　End If
　　　　End If
　　Loop
End With

End Sub

・ツリー全体表示


	【822】蛍光ペンの置き換えが表内で止まる

ぱたぱた - 17/7/31(月) 15:30 -


	引用なし

	パスワード

はじめまして。Wordマクロ初心者のため要領を得ないかもしれませんが、もしご存じの方がいらっしゃいましたら是非よろしくお願いいたします。

以下のような、黄緑色の蛍光ペンを検索して水色に置き換えるマクロを作成しました。
表の中に蛍光ペンを含まない場合は問題なく置換が完了するのですが、表の中に蛍光ペンを含む場合は蛍光ペンの色が何色か、置換するしないに関係なくそこで動作が止まってしまい、最終的にはWordを強制終了するしかなくなってしまいます。
おそらく表内の蛍光ペンの識別がうまくいかず止まっている（ぱっと見た感じでは無限ループのように見えます）のではないかと思うのですが、解決方法がわかりません。

表内の蛍光ペンは検索しないなどの方法でもかまいませんので、なんとか強制終了することなく置換を終えることはできないでしょうか。

よろしくお願いいたします。

Sub Replace_Color()

　　Selection.Find.ClearFormatting
　　Selection.Find.Highlight = True
　　Selection.Find.Replacement.ClearFormatting
　　Selection.Find.Replacement.Highlight = True
　　With Selection.Find
　　　　.Text = ""
　　　　.Replacement.Text = ""
　　　　.Forward = True
　　　　.Wrap = wdFindStop
　　　　.Format = True
　　　　.MatchCase = False
　　　　.MatchWholeWord = False
　　　　.MatchByte = False
　　　　.MatchAllWordForms = False
　　　　.MatchSoundsLike = False
　　　　.MatchWildcards = False
　　　　.MatchFuzzy = True
　　End With
　　Do
　　　　Selection.Find.Execute
　　　　If Not Selection.Find.Found Then Exit Do
　　　　
　　　　If Selection.Range.HighlightColorIndex = wdBrightGreen Then
　　　　　　Selection.Range.HighlightColorIndex = wdTurquoise
　　　　End If
　　Loop
　　
End Sub

・ツリー全体表示


	【821】Re:初心者です

マナ - 17/3/2(木) 20:11 -


	引用なし

	パスワード

▼Ka-sa さん：

処理したいファイルを、一つのフォルダにまとめておいて
下記マクロを実行します。

Option Explicit

Sub test()
　　Dim f As String
　　Dim tmp As String
　　Dim doc As Document
　　Dim r As Range
　　
　　
　　With Application.FileDialog(msoFileDialogFolderPicker)
　　　　.Title = "ワード文書があるフォルダを選択してください"
　　　　If .Show Then
　　　　　　f = .SelectedItems(1) & "\"
　　　　Else
　　　　　　MsgBox "操作を中止します"
　　　　　　Exit Sub
　　　　End If
　　End With
'
　　tmp = Dir(f & "*.docx")
'
　　Do While tmp <> ""
　　　　Set doc = Documents.Open(f & tmp)
　　　　Set r = doc.Content
　　　　
　　　　With r.Find
　　　　　　.MatchWildcards = True
　　　　　　.Text = "^13{2,}?"
　　　　　　.Replacement.Text = "^m"
　　　　　　.Execute Replace:=wdReplaceAll
　　　　End With
　　　　
　　　　doc.Close True
　　　　
　　　　tmp = Dir()
　　Loop
　　　　　　　　　　
End Sub

最終的には、１つずつ開いて確認が必要でしょうから
手作業で、置換操作をしても良い気がします。

・ツリー全体表示


	【820】Re:初心者です

Ka-sa

- 17/3/2(木) 0:02 -


	引用なし

	パスワード

▼マナさん：
>▼Ka-sa さん：
>
>改行が2個以上連続したら、改ページに置換する
>
>という処理で期待通りの結果になりそうですか
>それとも不都合ありますか

なるほど！問題ないです！

・ツリー全体表示


	【819】Re:初心者です

マナ - 17/3/1(水) 23:46 -


	引用なし

	パスワード

▼Ka-sa さん：

改行が2個以上連続したら、改ページに置換する

という処理で期待通りの結果になりそうですか
それとも不都合ありますか

・ツリー全体表示


	新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム

5 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free