[[20220926112456]]　『印刷範囲毎にシートを分けるマクロを教えて下さい』（りんご）　ページの最後に飛ぶ

『印刷範囲毎にシートを分けるマクロを教えて下さい』（りんご）

1枚のワークシートに複数のフォーマットの書類があります。
これを印刷範囲毎にワークシートを分けるマクロを設定
したくてネットを検索したら下記のマクロがありました。

Sub シート分割()
startrow = 1
lastrow = Worksheets(1).UsedRange.Rows.Count

With Worksheets(1)
For k = 1 To .HPageBreaks.Count
partrow = .HPageBreaks.Item(k).Location.Row - 1
Worksheets.Add after:=Worksheets(Worksheets.Count)
.Rows(startrow & ":" & partrow).Copy
Worksheets(Worksheets.Count).Range("A1").PasteSpecial
Application.CutCopyMode = False
startrow = partrow + 1
Next

Worksheets.Add after:=Worksheets(Worksheets.Count)
.Rows(startrow & ":" & lastrow).Copy
Worksheets(Worksheets.Count).Range("A1").PasteSpecial
Application.CutCopyMode = False
End With
End Sub

このマクロを使用すると印刷範囲毎でシートを分けてくれるんですが
基本となるワークシートに貼られている写真はコピーされませんでした。
写真や図も一緒にコピーしてくれるにはどうしたら良いですか？
教えて頂けますか？

よろしくお願いします。

＜使用 Excel：Excel2010、使用 OS：Windows10 ＞

まずは手動でやるとコピーされるのですか？
（what） 2022/09/26(月) 11:56

■１
コードの改造を試みる場合、まず元のコードを理解することが重要だと思います。
したがって、まずは【ステップ実行】を行って元のコードが何をやっているか研究するところから初めて見ては如何でしょうか？

※ステップ実行という言葉を聞いたことがなければ↓をお読み下さい

 【ステップ実行】
https://www.239-programing.com/excel-vba/basic/basic023.html
http://plus1excel.web.fc2.com/learning/l301/t405.html

 【ブレークポイント】
https://www.239-programing.com/excel-vba/basic/basic022.html
https://www.tipsfound.com/vba/01010

また↓も覚えておいて損はないでしょう。

 【イミディエイトウィンドウ】
https://www.239-programing.com/excel-vba/basic/basic024.html
https://excel-ubara.com/excelvba1/EXCELVBA486.html

 【ローカルウィンドウ】
https://excel-ubara.com/excelvba4/EXCEL266.html
http://excelvba.pc-users.net/fol8/8_2.html

■２
投稿時の問題だけかもしれませんが、実際もインデント（字下げ）が付いていないのであれば、インデントを付けることを検討してみて下さい。
適切なインデントを付けることにより、コードの構造が把握しやすくなり、ご自身のデバッグ作業の効率アップに繋がると思います。

■３
＞ワークシートに貼られている写真はコピーされませんでした。
元のコードが理解出来てからの話になりますが、【コピー】して【形式を選択して貼り付け】するのではなく、普通の【コピー＆ペースト】に書き換えて見てみてください。

 ※必要な命令は【マクロの記録】で調べることができます。

（もこな２） 2022/09/26(月) 12:10

コピぺの問題ではなく、オプションでセルとともコピー貼り付けをするとかに
チェックが入っているのを疑っているのだけれど。

しかし、アップデートのせいでできなくなってた事もあったし。
この辺は解らない。

因みにPasteSpecialだと狙ったとこに張り付けられます。
（what） 2022/09/26(月) 12:18

トピ主の反応がないですが、ちょっと興味がわいたので↓環境でテスト

 Windows10 バージョン21HS（OSビルド 19044.1889）
 Excel2016 MSO(16.0.4266.1001)64ビット

 1. 新規ブックを開き、シート上に適当なオートシェイプを作成

 2. ↑を２つ複製して、図形の書式設定の－プロパティを以下のように設定する
    １つめ･･･セルに合わせて移動やサイズ変更をする（もとのまま）
    ２つめ･･･セルに合わせて移動するがサイズ変更はしない
    ３つめ･･･セルに合わせて移動やサイズ変更をしない

 3. ↑が設置してあるセル範囲をコピー

 4. ちょっと離れた列（同じシート）に形式を選択して貼り付け－すべて を実行

 5. 結果いずれも貼りつかず

 6. 次に再度コピーして、さらにちょっと離れた列に普通に貼り付け

 7. 結果、３つめ以外が貼りついた

 8. 次に以下のコードを作成して実行
    Sub 実験()
        With Range("A1:C12") '図形3つが含まれているセル範囲
            .Copy
            .Offset(, 4).PasteSpecial xlPasteAll
            .Copy .Offset(, 8)
        End With
    End Sub

 9. 手作業と同じ結果（「7.」）が再現された

という状況なので、whatさんが仰るようにPasteSpecialの挙動がバージョンで変わっているのかもしれません。
一応、会社のPC（office365だったはず）でも同じ挙動（ただのコピペだとうまくいく）なので、図形の書式設定のプロパティを確認してみて、それでもだめなら普通のコピペに書き換えてみてはどうでしょうか？

（もこな２） 2022/09/26(月) 21:59

すみません。
PasteSpecialだとセルと一緒に張り付かなかった。

こんな感じにするか
Sheets("Sheet1").Range("A1:M30").Copy Sheets("Sheet2").Range("A2")

画像は画像でコピペ
Sheets("Sheet1").Pictures(1).Copy
Sheets("Sheet2").Range("A2").PasteSpecial
（what） 2022/09/26(月) 22:27

相変わらずトピ主の反応はありませんが、「（what） 2022/09/26(月) 22:27」の前者は、すでに私が述べている普通のコピペなので置いておくとして、後者のほうは１ページ当たりいくつのPicturesがあるかわかっていないとItem番号での取得が難しいですし、貼り付ける際もページ内のどのセルにどのように乗っかっていたかという情報がないから位置のコントロールが難しことになったりしませんか？
（1ページに必ず１つしかなくて、セルにピッタリ合わせて配置されているならいいのかもですが）

 ※そういう思惑じゃないということなら、余計なツッコミごめんなさい。

（もこな２） 2022/09/26(月) 23:29

皆さん色々なご回答ありがとうございました。
マクロ初心者のため、ご指摘頂いた内容を調べながら
作業していた為お返事が出来ませんでした。

まだ検証ができていない為出来次第コメント入れさせて
いただきます。

m(_ _)m
（りんご） 2022/09/27(火) 08:52

コメント返信：

[ 一覧(最新更新順) ]

[[20220926112456]] 『印刷範囲毎にシートを分けるマクロを教えて下さい』（りんご） ページの最後に飛ぶ

[[20220926112456]]　『印刷範囲毎にシートを分けるマクロを教えて下さい』（りんご）　ページの最後に飛ぶ