Word VBA質問箱 IV

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

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


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

5 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→


	【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個以上連続したら、改ページに置換する

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

・ツリー全体表示


	【818】初心者です

Ka-sa

- 17/2/28(火) 10:16 -


	引用なし

	パスワード

はじめまして。Ka-saです
今回初めてwordでマクロ作成しようと思っているのですが、
こういう風な仕様にしたい！という漠然としたイメージは出来ていますが
いざ組もうと思ったら全く出来ませんでした。
それでこの質問板見つけたので質問させていただきます。

自分は今、問題を作成しています。問題は1-100問あり１問１ページにしたいです。

問題は

1　○○のとき××。△△のとき□□はどうなるか。
1.　○
2.　×
3.　△
4.　▲
5.　●
改行
改行
改行

2.　○○のとき××。△△のとき□□はどうなるか。
1.　○
2.　×
3.　△
4.　▲
5.　●
改行
改行
：
：
：
という風になっておりこれが100問あります。
ファイルが全部で50近くあるのでとてもじゃないですが一つ一つやってる時間はないのでマクロでやりたいと思ってます。

どなたかおしえていただけないでしょうか？
よろしくお願いします。

・ツリー全体表示


	【817】Re:ワードでの拡張メタファイル貼付け

マナ - 17/1/13(金) 22:33 -


	引用なし

	パスワード

▼おーもりさん：

>ワードに貼り付けるところまでは出来るのですが図を選択できずその後の操作ができません。

「ホーム」ー「選択」ー「オブジェクトの選択と表示」を試してみてください

・ツリー全体表示


	【816】ワードでの拡張メタファイル貼付け

おーもり - 17/1/10(火) 7:37 -


	引用なし

	パスワード

スクリーンショットでキャプチャーした画像をワードに拡張メタファイルで張り付けたいです。
手動ではワード上にペーストで貼付け、一度図を選択してカット、形式を選択して拡張メタファイルで張り付けるという作業をしております。
これをマクロで行うことは可能でしょうか？
ワードに貼り付けるところまでは出来るのですが図を選択できずその後の操作ができません。

よろしくお願いします。
（ワード：2010を使用）

・ツリー全体表示


	【815】Re:Word VBAで指定個所に下線

マナ - 16/10/30(日) 14:01 -


	引用なし

	パスワード

シンプルでわかりやすいし、今の方法がよいのでは
というのが、わたしの考えです。

ということで、ほとんど同じですが、
置換を一括で行うように書き換えただけの案を提示。

Sub 下線を引く2()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Font.Underline = wdUnderlineNone
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub

該当箇所のみ下線を引こうとすると
コードがわかりにくくなるしメリットないような気がします。

Sub 下線を引く3()
　　Dim r As Range
　　Dim myKW As String

　　myKW = "□*^13"

　　Set r = ActiveDocument.Range

　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　Do While .Execute
　　　　　　If r.Paragraphs(1).Range.Characters(1) = "★" Then
　　　　　　　　r.MoveStart wdCharacter
　　　　　　　　r.Underline = wdUnderlineThick
　　　　　　End If
　　　　　　r.Collapse wdCollapseEnd
　　　　Loop

　　End With

End Sub

Sub 下線を引く4()
　　Dim r As Range
　　Dim myKW As String, repWd As String
　　Dim myKW2 As String, repWd2 As String

　　myKW = "<(★*□)(*)^13"
　　repWd = "\1〒\2〒^p"
　　
　　myKW2 = "〒(*)〒"
　　repWd2 = "\1"

　　Set r = ActiveDocument.Range
　
　　With r.Find
　　　　.MatchWildcards = True
　　　　.Text = myKW
　　　　.Replacement.Text = repWd
　　　　.Execute Replace:=wdReplaceAll
　　　　.Text = myKW2
　　　　.Replacement.Text = repWd2
　　　　.Replacement.Font.Underline = wdUnderlineThick
　　　　.Execute Replace:=wdReplaceAll
　　End With
　　
End Sub

・ツリー全体表示


	【814】Word VBAで指定個所に下線

マナ - 16/10/30(日) 13:14 -


	引用なし

	パスワード

よその掲示板であったWordに関する質問です。
向こうはExcel VBAの掲示板なので、
Excelと関係ないWordのやりとりすることに
抵抗がありましたので、この場をお借りまします。

Word VBAで指定個所に下線
excelfactory.net/excelboard/excelvba/excel.cgi?mode=all&namber=178971&rev=0

質問はこんな感じ：
１）段落が★で始まるとき、
２）□の次の文字から段落末（改行）まで
３）下線を引く

下記のマクロでは、一度下線を引いてから、
不要箇所の下線をけしているので無駄に思える。
最初から、目的の箇所のみに下線を引きたい。

ちょっと編集していますが、
概ねこんな内容の質問です。

Sub 下線を引く1()
　　Dim r As Range
　　Dim myKW As String
　　Dim myKW2 As String

　　myKW = "<★*^13"
　　myKW2 = "<★*□"

　　Set r = ActiveDocument.Range(0, 0)
　
　　With r.Find
　　　　.Text = myKW
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineThick '太下線
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With
　　
　　Set r = ActiveDocument.Range(0, 0)
　　
　　With r.Find
　　　　.Text = myKW2
　　　　.MatchWildcards = True
　　End With
　　With r
　　　　Do While .Find.Execute = True
　　　　　　.Underline = wdUnderlineNone '下線なし
　　　　　　.Collapse direction:=wdCollapseEnd
　　　　Loop
　　End With

End Sub

・ツリー全体表示


	【813】Re:選択範囲内の文字列検索

マナ - 16/9/10(土) 11:44 -


	引用なし

	パスワード

１行追加してみました。
出来ているような気がしています。

Sub 選択範囲内の文字列検索2()
　　Dim r As Range
　　Dim n As Long

　　Set r = Selection.Range
　　r.Collapse wdCollapseStart　'★追加
　　
　　With r.Find
　　　　.Text = "検索ワード"
　　　　Do While .Execute
　　　　　　If Not r.InRange(Selection.Range) Then Exit Do
　　　　　　n = n + 1
　　　　Loop
　　End With
　　
　　MsgBox n & "個"
　　
End Sub

・ツリー全体表示


	【812】選択範囲内の文字列検索

マナ - 16/9/10(土) 11:12 -


	引用なし

	パスワード

Word質問箱は、利用者いないから廃止
ということは、ないと思いますが。
書込みしておきます。

ht　tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=715;id=word

の続きです。
選択範囲内の文字列検索する下記マクロ

Sub 選択範囲内の文字列検索()
　　Dim r As Range
　　Dim n As Long
　　
　　Set r = Selection.Range
　　
　　With r.Find
　　　　.Text = "検索ワード"
　　　　Do While .Execute
　　　　　　If Not r.InRange(Selection.Range) Then Exit Do
　　　　　　n = n + 1
　　　　Loop
　　End With
　　
　　MsgBox n & "個"
　　
End Sub

でも、検索範囲と検索語が同じだった場合は失敗する。
０個になってしまう。

・ツリー全体表示


	【811】Re:ルビの入力設定

マナ - 15/10/10(土) 18:27 -


	引用なし

	パスワード

▼こっこさん：

設定ではできないようで、代案です。

期待のものと違うと思いますが、
↓のマクロが役立ちそうです。
ht　tp://www.ka-net.org/blog/?p=4562

・ツリー全体表示


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

5 / 45 ﾍﾟｰｼﾞ

←次へ　｜　前へ→

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free