Word VBA質問箱 IV

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

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

  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
4 / 308 ﾂﾘｰ ←次へ　｜　前へ→
▼ 【894】指定ページを別ファイルに貼り付ける massan 20/11/27(金) 0:17 質問[未読]
【895】Re:指定ページを別ファイルに貼り付ける マナ 20/11/29(日) 9:54 発言[未読]
【896】Re:指定ページを別ファイルに貼り付ける massan 20/11/29(日) 19:47 質問[未読]
【897】Re:指定ページを別ファイルに貼り付ける massan 20/11/29(日) 21:24 質問[未読]
【898】Re:指定ページを別ファイルに貼り付ける マナ 20/11/29(日) 22:30 発言[未読]
【899】Re:指定ページを別ファイルに貼り付ける マナ 20/11/29(日) 23:40 発言[未読]
【900】Re:指定ページを別ファイルに貼り付ける massan 20/12/3(木) 1:07 お礼[未読]
【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
【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
【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の最後の箇条書きの数字が増えていきます。何が影響しているのでしょうか？
【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
時間ありましたら、宜しく、お願いします。
【898】Re:指定ページを別ファイルに貼り付ける
発言  マナ  - 20/11/29(日) 22:30 -
引用なし
パスワード
   ▼massan さん：

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

この掲示板に、直接コピペしていただけませんか。
箇条書き番号の件は、手作業でもそうなりますので
わたしには、手におえません。
ネットで検索してみます。
【899】Re:指定ページを別ファイルに貼り付ける
発言  マナ  - 20/11/29(日) 23:40 -
引用なし
パスワード
   箇条書き番号は、ここを参考にできませんか？
ht tps://wordmvp.com/FAQs/Numbering/ListRestartFromVBA.htm
【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です。

それにしても、最初に戻りますが配列を使うとなぜ全て最後のページになるのでしょう？
  新規投稿 ┃ツリー表示 ┃一覧表示 ┃トピック表示 ┃検索 ┃設定 ┃ホーム  
4 / 308 ﾂﾘｰ ←次へ　｜　前へ→
ページ：  ┃  記事番号：
207156
(SS)C-BOARD v3.8 is Free