Word VBA質問箱 IV

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

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


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

1 / 45 ﾍﾟｰｼﾞ


	【911】Re:テキストボックス内の文字を一括で置換...

ぺろ - 24/10/25(金) 14:11 -


	引用なし

	パスワード

▼マナさん

コードありがとうございます。
おかげ様で無事動作させることができました。

・ツリー全体表示


	【910】Re:テキストボックス内の文字を一括で置換...

マナ - 24/10/15(火) 7:46 -


	引用なし

	パスワード

-▼ぺろさん：

Sub test()
　Dim fdg As FileDialog, p As String
　Dim fso As Object, f As Object
　Dim doc As Document, s As Shape, r As Range
　Dim flg As Boolean
　
　　Set fdg = Application.FileDialog(msoFileDialogFolderPicker)
　　If Not fdg.Show Then Exit Sub
　　p = fdg.SelectedItems(1) & "\"
　　
　　 Set fso = CreateObject("scripting.filesystemobject")

　　For Each f In fso.getfolder(p).Files
　　　　If LCase(fso.getextensionname(f.Path)) = "docx" Then
　　　　　　Set doc = Documents.Open(f.Path)
　　　　　　For Each s In doc.Shapes
　　　　　　　　Set r = s.TextFrame.TextRange
　　　　　　　　With r.Find
　　　　　　　　　　.Text = "あいうえお" '検索する文字列
　　　　　　　　　　.Replacement.Text = "かきくけこ"　 '置換後の文字列
　　　　　　　　　　.Execute Replace:=wdReplaceAll
　　　　　　　　　　If .Found Then flg = True
　　　　　　　　End With
　　　　　　Next
　　　　　　doc.Close flg
　　　　　　flg = False
　　　　End If
　　Next
　　
End Sub

・ツリー全体表示


	【909】テキストボックス内の文字を一括で置換した...

ぺろ - 24/9/23(月) 15:43 -


	引用なし

	パスワード

テキストボックスとして配置された指定の文字だけを一括で置換を行いたいのですが、複数ファイルがある場合の設定方法をご教授いただけますと幸いです。

１つのファイルの場合ですと下記コードを実行する事で思った動作はしているのですが、複数となった場合のファイルパスの指定方法が分からず…

Sub テキストボックス置換するマクロ()

　　Dim i As Integer

　　'Shapeオブジェクトに対して置換実行
　　For i = 1 To ActiveDocument.Shapes.Count

　　　　ActiveDocument.Shapes(i).Select

　　　　Selection.Find.ClearFormatting
　　　　Selection.Find.Replacement.ClearFormatting
　　　　With Selection.Find
　　　　　　.Text = "あいうえお" '検索する文字列
　　　　　　.Replacement.Text = "かきくけこ" 　'置換後の文字列
　　　　　　.Forward = True
　　　　　　.Wrap = wdFindContinue
　　　　　　.Format = False
　　　　　　.MatchCase = False
　　　　　　.MatchWholeWord = False
　　　　　　.MatchByte = False
　　　　　　.MatchAllWordForms = False
　　　　　　.MatchSoundsLike = False
　　　　　　.MatchWildcards = False
　　　　　　.MatchFuzzy = False
　　　　End With
　　　　Selection.Find.Execute Replace:=wdReplaceAll

　　Next i

End Sub

・ツリー全体表示


	【908】Re:Wordで塗りつぶしされ文字だけ検索した...

マナ - 24/8/4(日) 8:46 -


	引用なし

	パスワード

▼M さん：

Sub test2()
　　Dim dic As Object
　　Dim r As Range

　　Set dic = CreateObject("scripting.dictionary")
　　Set r = ActiveDocument.Content

　　With r.Find
　　　　.Font.Shading.BackgroundPatternColor = wdColorYellow
　　　　Do While .Execute
　　　　　　dic(dic.Count) = r.Text
　　　　Loop
　　End With
　
　　If dic.Count > 0 Then
　　　　Documents.Add.Range.Text _
　　　　　　= "検索結果:" & vbCr & Join(dic.items, vbCr)
　　End If

End Sub

・ツリー全体表示


	【907】Re:Wordで塗りつぶしされ文字だけ検索した...

M

- 24/8/3(土) 23:25 -


	引用なし

	パスワード

▼マナさん：
>▼M さん：

ご返信が遅くなり申し訳ございません。
うまく動きました！

うまく動きましたが、私が検索したいのは蛍光ペンではなく、
塗りつぶしされた箇所なのですが、その場合はどのようなコードになりますでしょうか？

ご教授いただけると幸いです。

・ツリー全体表示


	【906】Re:Wordで塗りつぶしされ文字だけ検索した...

マナ - 24/7/31(水) 9:20 -


	引用なし

	パスワード

▼M さん：

塗りつぶしが黄色の蛍光ペンだとして

Sub test()
　　Dim dic As Object
　　Dim r As Range

　　Set dic = CreateObject("scripting.dictionary")
　　Set r = ActiveDocument.Content

　　With r.Find
　　　　.Highlight = True
　　　　Do While .Execute
　　　　　　Do While r.HighlightColorIndex = wdUndefined
　　　　　　　　r.MoveEnd Unit:=wdCharacter, Count:=-1
　　　　　　Loop
　　　　　　If r.HighlightColorIndex = wdYellow Then
　　　　　　　　dic(dic.Count) = r.Text
　　　　　　End If
　　　　Loop
　　End With
　　
　　If dic.Count > 0 Then
　　　　Documents.Add.Range.Text _
　　　　　　= "検索結果:" & vbCr & Join(dic.items, vbCr)
　　End If

End Sub

・ツリー全体表示


	【905】Re:Wordで塗りつぶしされ文字だけ検索した...

M

- 24/7/30(火) 22:52 -


	引用なし

	パスワード

▼マナさん：
>▼M さん：
>選択したあと、どのような操作を考えていますか。
>同時に全選択された状態である必要がありますか。

ご返信ありがとうございます。
該当箇所だけを抜き出したいので、全選択でコピーしたいのです。

・ツリー全体表示


	【904】Re:Wordで塗りつぶしされ文字だけ検索した...

マナ - 24/7/28(日) 19:39 -


	引用なし

	パスワード

▼M さん：
>Wordで特定の色で塗りつぶしをされた文字だけを検索して、
>該当箇所をすべて選択したいです。
>
選択したあと、どのような操作を考えていますか。
同時に全選択された状態である必要がありますか。

・ツリー全体表示


	【903】Wordで塗りつぶしされ文字だけ検索したい。

M

- 24/7/28(日) 14:29 -


	引用なし

	パスワード

Wordで特定の色で塗りつぶしをされた文字だけを検索して、
該当箇所をすべて選択したいです。

chatGPTに聞いた下記のコードでは、エラーメッセージが出て検索できませんでした。
どこが違うのか、ご教授いただけますと幸いです。

Sub FindShadedText()
　　Dim searchColor As Long
　　Dim rng As Range
　　Dim found As Boolean
　　
　　' 検索する塗りつぶし色を設定（RGB値）
　　searchColor = RGB(255, 255, 0) ' 黄色の例

　　' ドキュメントの全範囲を設定
　　Set rng = ActiveDocument.Content
　　
　　' 範囲の最初に移動
　　rng.Collapse Direction:=wdCollapseStart
　　
　　' 塗りつぶし色を検索
　　found = False
　　Do While rng.Find.Execute(FindText:="", Format:=True)
　　　　If rng.Shading.BackgroundPatternColor = searchColor Then
　　　　　　rng.Select
　　　　　　found = True
　　　　　　Exit Do
　　　　End If
　　　　rng.Collapse Direction:=wdCollapseEnd
　　Loop
　　
　　If Not found Then
　　　　MsgBox "指定された塗りつぶし色のテキストが見つかりませんでした。"
　　End If
End Sub

・ツリー全体表示


	【902】Re:隠し文字非表示状態のファイルページ総...

ファイルの総ページ数 - 21/9/4(土) 6:58 -


	引用なし

	パスワード

自己解決です。
文字の隠し文字表示をfalse にするコードを前に記載することで、適切に取得することができました。

・ツリー全体表示


	【901】隠し文字非表示状態のファイルページ総数取...

ファイルの総ページ数 - 21/9/1(水) 4:00 -


	引用なし

	パスワード

隠し文字を含むWordファイルの、隠し文字非表示状態のページ数を取得したいと思うのですが、隠し文字表示状態のページ数（wdNumberOfPagesInDocument）しか取得する方法がわかりません。
適切なコードがあれば教えていただけると助かります。
よろしくお願いいたします。

・ツリー全体表示


	【900】Re:指定ページを別ファイルに貼り付ける

massan - 20/12/3(木) 1:07 -


	引用なし

	パスワード

▼マナさん：
>箇条書き番号は、ここを参考にできませんか？
>ht tps://wordmvp.com/FAQs/Numbering/ListRestartFromVBA.htm

マナさん、ありがとうございます。Numbering Listですか、勉強してみます。

Sub test1()　　　　 'マナさんより　.InsertBreak wdPageBreak削除にて白紙除去，但し箇条書き数字増える
　　Dim r As Range
　　Dim k As Long
　　Dim doc As Document
　
　　Set r = ThisDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, 3)
　　Set r = r.GoTo(wdGoToBookmark, , , "\page")
　　Set doc = Documents.Open(ThisDocument.Path & "\DataRec.docx")

　　For k = 1 To 3
　　　　ThisDocument.Shapes("MyNo").TextFrame.TextRange.Text = k
　　　　doc.Bookmarks("\EndOfDoc").Range.FormattedText = r.FormattedText
　　Next
　
End Sub
Sub testR()　　　　 'Selectionはあるが、箇条書き数字は維持される
　　Dim r As Range
　　Dim k As Long
　　Dim doc As Document
　
　　Set r = ThisDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, 3)
　　Set r = r.GoTo(wdGoToBookmark, , , "\page")
　　Set doc = Documents.Open(ThisDocument.Path & "\DataRec.docx")

　　For k = 1 To 3
　　　　ThisDocument.Shapes("MyNo").TextFrame.TextRange.Text = k
　　　　r.Select: Selection.Copy
　　　　doc.Bookmarks("\EndOfDoc").Range.PasteAndFormat (wdFormatOriginalFormatting)
　　Next
　　　　Selection.Collapse Direction:=wdCollapseStart　　　　　　　 'Sel解除
End Sub

test1は白紙除去できましたが、箇条書きのNumberingが増えていきます。
testRはコピペが美しくないですが、箇条書きのNumberingはOKです。

それにしても、最初に戻りますが配列を使うとなぜ全て最後のページになるのでしょう？

・ツリー全体表示


	【899】Re:指定ページを別ファイルに貼り付ける

マナ - 20/11/29(日) 23:40 -


	引用なし

	パスワード

箇条書き番号は、ここを参考にできませんか？
ht tps://wordmvp.com/FAQs/Numbering/ListRestartFromVBA.htm

・ツリー全体表示


	【898】Re:指定ページを別ファイルに貼り付ける

マナ - 20/11/29(日) 22:30 -


	引用なし

	パスワード

▼massan さん：

>すみません。こちらにもリンク貼っておきます。
>https://app.box.com/s/yb6joa35i1tlc0jw46lr7xl9conk78v0
>時間ありましたら、宜しく、お願いします。

この掲示板に、直接コピペしていただけませんか。
箇条書き番号の件は、手作業でもそうなりますので
わたしには、手におえません。
ネットで検索してみます。

・ツリー全体表示


	【897】Re:指定ページを別ファイルに貼り付ける

massan - 20/11/29(日) 21:24 -


	引用なし

	パスワード

▼massan さん：
>▼マナさん：
>>▼massan さん：
>>
>>たたき台です。
>>
>>Sub test()
>>　　Dim r As Range
>>　　Dim k As Long
>>　　Dim doc As Document
>>　　
>>　　Set r = ThisDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, 3)
>>　　Set r = r.GoTo(wdGoToBookmark, , , "\page")
>>　　Set doc = Documents.Open(ThisDocument.Path & "\DataRec.docx")
>>
>>　　For k = 1 To 3
>>　　　　ThisDocument.Shapes("MyNo").TextFrame.TextRange.Text = k
>>　　　　With doc.Bookmarks("\EndOfDoc").Range
>>　　　　　　.InsertBreak wdPageBreak
>>　　　　　　.FormattedText = r.FormattedText
>>　　　End With
>>　　Next
>>　　
>>End Sub
>
>マナさん
>早速の回答有難うございます。SelectionなしでページをRangeに,さすがですね。またActiveDocumentでなく、Documentとして扱えば済むことも、学べました。
>次のところに、例文を置いて置きます。
>ようこそ (file://DESKTOP-S2PA5MR/Users/MASA/Desktop/ようこそ)
>マナさんのものを実行するとPage3が２ページ分となり、またPage3の最後の箇条書きの数字が増えていきます。何が影響しているのでしょうか？

マナさん
すみません。こちらにもリンク貼っておきます。
https://app.box.com/s/yb6joa35i1tlc0jw46lr7xl9conk78v0
時間ありましたら、宜しく、お願いします。

・ツリー全体表示


	【896】Re:指定ページを別ファイルに貼り付ける

massan - 20/11/29(日) 19:47 -


	引用なし

	パスワード

▼マナさん：
>▼massan さん：
>
>たたき台です。
>
>Sub test()
>　　Dim r As Range
>　　Dim k As Long
>　　Dim doc As Document
>　　
>　　Set r = ThisDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, 3)
>　　Set r = r.GoTo(wdGoToBookmark, , , "\page")
>　　Set doc = Documents.Open(ThisDocument.Path & "\DataRec.docx")
>
>　　For k = 1 To 3
>　　　　ThisDocument.Shapes("MyNo").TextFrame.TextRange.Text = k
>　　　　With doc.Bookmarks("\EndOfDoc").Range
>　　　　　　.InsertBreak wdPageBreak
>　　　　　　.FormattedText = r.FormattedText
>　　　End With
>　　Next
>　　
>End Sub

マナさん
早速の回答有難うございます。SelectionなしでページをRangeに,さすがですね。またActiveDocumentでなく、Documentとして扱えば済むことも、学べました。
次のところに、例文を置いて置きます。
ようこそ (file://DESKTOP-S2PA5MR/Users/MASA/Desktop/ようこそ)
マナさんのものを実行するとPage3が２ページ分となり、またPage3の最後の箇条書きの数字が増えていきます。何が影響しているのでしょうか？

・ツリー全体表示


	【895】Re:指定ページを別ファイルに貼り付ける

マナ - 20/11/29(日) 9:54 -


	引用なし

	パスワード

▼massan さん：

たたき台です。

Sub test()
　　Dim r As Range
　　Dim k As Long
　　Dim doc As Document
　　
　　Set r = ThisDocument.Range.GoTo(wdGoToPage, wdGoToAbsolute, 3)
　　Set r = r.GoTo(wdGoToBookmark, , , "\page")
　　Set doc = Documents.Open(ThisDocument.Path & "\DataRec.docx")

　　For k = 1 To 3
　　　　ThisDocument.Shapes("MyNo").TextFrame.TextRange.Text = k
　　　　With doc.Bookmarks("\EndOfDoc").Range
　　　　　　.InsertBreak wdPageBreak
　　　　　　.FormattedText = r.FormattedText
　　　End With
　　Next
　　
End Sub

・ツリー全体表示


	【894】指定ページを別ファイルに貼り付ける

massan - 20/11/27(金) 0:17 -


	引用なし

	パスワード

初めまして,Word VBAに関しましてはほぼ初心者の老人です。
本文の３ページに数字0-5を順次を貼付け、それを別ファイル(DataRec)に貼り付けるとします。ActiveWindowの切り替え防止のため、３Pageを順次、配列に収納、収納完了後、別ファイルをOpenし配列を呼び出しコピペするようにしたいと思います。以下のVBAで行うと以下の不具合が出ました。

１、ページ指定が０からはじまる(３ページ指定には２)
２、実行後、別ファイルには全て変化させた最終ページ(数字5を貼り付けた3ページ)が全て(6ページ分)貼りつく
３、貼り付けられたページの書式が元とことなる(行間等)
宜しくご教示ください。

Sub Pg3toRec() '3pgを文書XにPaste

Dim BufRng(20) As Range
Dim myCNT As Integer
Dim MyNo As Integer

Selection.GoTo What:=wdGoToPage, Which:=wdGoToNext, Name:=2 'Pg3をSel
ActiveDocument.Bookmarks("\page").Range.Select
MyNo = 5

For myCNT = 0 To MyNo
ActiveDocument.Shapes("MyNo").TextFrame.TextRange.Text = myCNT 'Pg3上のMyNoへ書込み
Set BufRng(myCNT) = Selection.Range '配列に収納
Next
Selection.Collapse Direction:=wdCollapseStart 'Sel解除
Documents.Open ThisDocument.Path & "\DataRec.docx" 'DataRecを開く

For myCNT = 0 To MyNo
BufRng(myCNT).Copy '配列Copy
ActiveDocument.Bookmarks("\EndOfDoc").Select '文書の末尾を選択
Selection.PasteAndFormat (wdFormatOriginalFormatting) 'Paste
Next
Windows("DataRec").Activate
End Sub

・ツリー全体表示


	【893】文書校正の詳細設定をVBAで設定したい

ロアロア - 20/8/21(金) 16:53 -


	引用なし

	パスワード

はじめて質問させていただきます。
VBAで、［ファイル］→［オプション］→［文書校正］→文書のスタイルの［設定］
にて表示される「文書校正の詳細設定」ダイアログ内のオプションの［文体］を
”「だ・である」体に統一”または”「です・ます」体に統一”
のどちらかに設定して文書校正を実行したいのですが、
ドキュメントなどを探しても方法が見つかりませんでした。
ご存じの方、ご教授願います。

・ツリー全体表示


	【892】wordにEMFファイルを挿入

ねまねま - 19/11/24(日) 16:02 -


	引用なし

	パスワード

WORD文書に.InlineShapes.AddPictureを使用してEMFファイルを挿入をしたところ、ラスタ画像（ビットマップ画像？）になって張り付いてしまいました。
ベクタ形式のまま、張り付ける方法を教えてください。

手動でエクスプローラーからWORDページへのD&Dすると希望する結果になるのですが、EMFの数が沢山あるのでマクロで処理したいです。

現在、PlayEnhMetaFileとかいうAPIで処理できないものかと調べているのですが、描画するデバイスコンテキストを取得する手段もわかりません。

よろしくお願いします。

・ツリー全体表示


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

1 / 45 ﾍﾟｰｼﾞ

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free