Word VBA質問箱 IV

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

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


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

1 / 44 ﾍﾟｰｼﾞ


	【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で処理できないものかと調べているのですが、描画するデバイスコンテキストを取得する手段もわかりません。

よろしくお願いします。

・ツリー全体表示


	【891】wordについて。

コルム - 19/7/18(木) 16:24 -


	引用なし

	パスワード

wordで、便箋をtab キーを使って作る方法を教えていただけると幸いです。
表を挿入して、8行1列の表を挿入して、tabキーを使って、20行まで増やすやり方でも良いのでしょうか？後で、表示形式を、右罫線、左罫線を消して、横線を、破線を選べば良いのでしょうか？教えていただけると幸いです。
https://6900.teacup.com/cgu135/bbs/803

・ツリー全体表示


	【890】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/5(金) 12:06 -


	引用なし

	パスワード

▼マナさん：

>この通りしていますか。
>変更していませんか。

すみません！
きちんとコードを転機できておりませんでした。
修正しましたところ、目的の動作ができました。

ありがとうございました。
大変助かりました。

・ツリー全体表示


	【889】Re:検索文字の後ろに文字挿入

マナ - 19/7/4(木) 20:17 -


	引用なし

	パスワード

▼あおぎんこさん：

>検索文字の後ではなく、ファイルのいちばん最後に文字が挿入されます。

>>　　　　　　wrdRng.InsertAfter "挿入文字"

この通りしていますか。
変更していませんか。

・ツリー全体表示


	【888】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/4(木) 19:23 -


	引用なし

	パスワード

▼マナさん：

さっそくの回答ありがとうございます。
ご提示のコードに変更しましたら、エラーは出なくなりました！

しかしながら、、
検索文字の後ではなく、ファイルのいちばん最後に文字が挿入されます。

質問ばかりで申し訳ないですが、解決方法がありましたら、ご教示いただ
けるとありがたいです。

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

>▼あおぎんこさん：
>
>Sub test()
>　　Dim strFile As String
>　　Dim wrdApp As Object
>　　Dim wrdDoc As Object
>　　Dim wrdRng As Object
>　
>　　strFile = "ダイアログで選択したWordファイルのフルパス"
>　　
>　　Set wrdApp = CreateObject("Word.Application")
>　　w rdApp.Visible = True
>　　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く
>
>　　Set wrdRng = wrdDoc.Range
>　　With wrdRng.Find
>　　　　.Text = "検索文字"
>　　　　If .Execute Then
>　　　　　　wrdRng.InsertAfter "挿入文字"
>　　　　End If
>　　End With
>
>　　'～ファイル保存処理～
>　
>End Sub

・ツリー全体表示


	【887】Re:検索文字の後ろに文字挿入

マナ - 19/7/3(水) 23:07 -


	引用なし

	パスワード

▼あおぎんこさん：

>ご提示のコードを組み込んでみましたところ、Set r = ActiveDocument.Range　
>のところで型が一致しません　と出ます。

Sub test()
　　Dim strFile As String
　　Dim wrdApp As Object
　　Dim wrdDoc As Object
　　Dim wrdRng As Object
　
　　strFile = "ダイアログで選択したWordファイルのフルパス"
　　
　　Set wrdApp = CreateObject("Word.Application")
　　w rdApp.Visible = True
　　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く

　　Set wrdRng = wrdDoc.Range
　　With wrdRng.Find
　　　　.Text = "検索文字"
　　　　If .Execute Then
　　　　　　wrdRng.InsertAfter "挿入文字"
　　　　End If
　　End With

　　'～ファイル保存処理～
　
End Sub

・ツリー全体表示


	【886】Re:検索文字の後ろに文字挿入

あおぎんこ - 19/7/3(水) 14:29 -


	引用なし

	パスワード

▼マナさん：

回答ありがとうございます。
そして、すっかりお礼が遅くなって申し訳ありません。

ご提示のコードを組み込んでみましたところ、Set r = ActiveDocument.Range　
のところで型が一致しません　と出ます。
いただいたtestコードをwordで実行するとうまくいくので、これを元に何とか
しようと思ったのですが、行き詰っております。
エクセルから操作しているので、うまくいかないのでしょうか・・？？
ご教示いただけるとありがたいです。。

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

Sub サンプル()

Dim strFile As String
Dim wrdApp As Object
Dim wrdDoc As Object
Dim wrdRng As Object
　　
　strFile = "ダイアログで選択したWordファイルのフルパス"
　　　　
　Set wrdApp = CreateObject("Word.Application")’ワードを開く
　wrdApp.Visible = True
　Set wrdDoc = wrdApp.Documents.Open(strFile)　'指定のワードファイルを開く
　　wrdDoc.Range.WholeStory
　　　
　　Dim r As Range
　 Set r = ActiveDocument.Range　←「型が一致しません」
　　
　　With r.Find
　　　　.Text = "検索文字"
　　　　If .Execute Then
　　　　　　r.InsertAfter "挿入文字"
　　　　End If
　　End With

　'～ファイル保存処理～
　
　　
End Sub

>▼あおぎんこさん：
>
>Sub test()
>　　Dim r As Range
>　　
>　　Set r = ActiveDocument.Range
>　　
>　　With r.Find
>　　　　.Text = "検索文字"
>　　　　If .Execute Then
>　　　　　　r.InsertAfter "挿入文字"
>　　　　End If
>　　End With
>
>End Sub

・ツリー全体表示


	【885】Re:ファイル分割

ころんさん - 19/6/30(日) 8:20 -


	引用なし

	パスワード

マナさん、助言ありがとうございます。
ページ削除の対応で、問題なく分割することができました。

・ツリー全体表示


	【884】Re:ファイル分割

マナ - 19/6/25(火) 22:31 -


	引用なし

	パスワード

▼ころんさん：

これでは、だめなんですよね。
ht tp://www.vbalab.net/vbaqa/c-board.cgi?cmd=ntr;tree=869;id=word

>ファイルのページ設定やヘッダーやフッターを維持して、ファイルを指定するページ毎に分割したいと考えています。

１）文書を複製して
２）不要なページを削除
３）名前をつけて保存

これの繰り返しでできませんか。
ページ番号とかが維持されないような気がしますが・・・

　

・ツリー全体表示


	【883】ファイル分割

ころん - 19/6/24(月) 2:09 -


	引用なし

	パスワード

ファイルのページ設定やヘッダーやフッターを維持して、ファイルを指定するページ毎に分割したいと考えています。
ファイルのセクションごとに分割できるコードを見つけたのですが、これを指定するページ毎に分割できるようにするにはどうしたらよいのかご教示いただけないでしょうか。

Sub ファイル分割()
Dim doc As Document
Dim newDoc As Document
Dim i As Long, j As Long
Set doc = ActiveDocument
doc.SaveAs2 doc.Path & "\" & "ファイル名.docx"
For i = 1 To doc.Sections.Count
Set newDoc = Application.Documents.Add(Template:=doc.Path & "\" & "ファイル名.docx")
For j = doc.Sections.Count To 1 Step -1
If j <> i Then newDoc.Sections(j).Range.Delete
Next
newDoc.SaveAs2 doc.Path & "\" & "ファイル名_" & i & ".docx"
newDoc.Close
Next
End Sub

・ツリー全体表示


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

1 / 44 ﾍﾟｰｼﾞ

ページ：

┃

記事番号：

(SS)C-BOARD v3.8 is Free