【Excel】マクロでページを追加することはできますか？

Question

いつもお世話になっております。
Excel2003使用して、Sheet1に１ページ分のひな形(A1:X40)を作り、このひな形をコピーして使っています。
例えば、Sheet2の１ページ目の入力欄がなくなったので、Sheet1のA1:X40の範囲を２ページ目としてコピペして追加したいのですが、マクロで可能でしょうか？もし可能であれば、どのようにコードを書いたらいいでしょうか？
マクロ勉強中です。よろしくお願いします！

hana-hana3 · Accepted Answer

選択した位置(ActiveCell)に「ひな形」をコピーします。

Sub cpy()
    Sheets("Sheet1").Range("A1:X40").Copy ActiveCell
End Sub

KenKen_SP · Answer

こんにちは。

> もともと、空き行を想定していたりすると、レイアウトが崩れたりするので、
> あまり好まれません。

確かにそうですね^^;

では、空行をパラメータとしてもっておき、ページの切れ目ではなく、ページの
頭に改ページを挿入するというロジックでどうですか？

Sub InsTemplate()

　　Dim Sh　 As Worksheet
　　Dim rSrc As Range
　　Dim rDst As Range
　　
　　' 設定 ------------------------------------------------------------
　　' 雛形ごとに空行を設けたいとき（現在 1 行）
　　Const MARGIN_ROW As Long = 1
　　' 雛形のセル範囲(行の高さもコピーするので行全体で指定します）
　　Set rSrc = Worksheets("Sheet1").Rows("1:40")
　　' 貼り付け先のシート
　　Set Sh = Worksheets("Sheet2")
　　' -----------------------------------------------------------------
　　
　　Application.ScreenUpdating = False
　　' 既存データの有無で分岐処理
　　If Application.CountA(Sh.Cells) = 0 Then
　　　　' 空シートの場合は貼り付け先を１行目とし列幅をテンプレートにそろえる
　　　　Set rDst = Sh.Rows(1)
　　　　rSrc.Parent.Cells.Copy
　　　　rDst.PasteSpecial xlPasteColumnWidths
　　Else
　　　　' 既にデータがあるシートなら使用済み最終セルから転記先を参照
　　　　Set rDst = Sh.UsedRange
　　　　Set rDst = Sh.Rows(rDst.Cells(rDst.Count).Row + MARGIN_ROW + 1)
　　End If
　　' 雛形を複写
　　Sh.Activate
　　rSrc.Copy
　　rDst.PasteSpecial xlPasteAll
　　' 雛形の頭に水平改ページを挿入（rDst.Row = 1 のエラートラップ）
　　On Error Resume Next
　　Sh.HPageBreaks.Add Before:=rDst
　　On Error GoTo 0
　　' 印刷範囲を拡張
　　Sh.PageSetup.PrintArea = Sh.UsedRange.Address
　　' 後始末ほか
　　Application.ScreenUpdating = True
　　' 貼り付け先までスクロールさせます
　　Application.Goto Reference:=Selection, Scroll:=True
　　Set rSrc = Nothing: Set rDst = Nothing: Set Sh = Nothing
　　
End Sub

' # マクロ勉強中とのことですから、#1 ご回答が汎用的・シンプルで一番良い
' # と思います。ご参考までということで。

Wendy02 · Answer

こんにちは。

>『実行時エラー９　インデックスが有効範囲にありません』

それは、実際のシート名と、マクロのSheets("Sheet1") が合っていないからではないでしょうか？インデックスというのは、シート名のことのはずですから。

私も考えてみましたが、

>Sheet1のA1:X40の範囲を２ページ目としてコピペして追加したいのですが、マクロで可能でしょうか？

この手のマクロは、私の考え方からすると、かなりむつかしいです。

２ページ目に入るためには、　A1:X40 次は、どこに貼り付けるか？
と同じ質問ですね。難問だと思います。

要するに、二つの方法があると思います。

1.　ページの切れ目に、手動改ページを入れること。
　(比較的簡単です。もともと、空き行を想定していたりすると、レイアウトが崩れたりするので、あまり好まれません。)

2.　貼り付けた後の水平自動改ページの位置を探すこと。

2 は、貼り付け時点では、１ページが決まっていないわけで、水平自動改行(HPageBreak) がありません。したがって、そのまま貼り付けると、ページの切れ目にデータが載って、データが切れ切れになってしまいます。

以下のコードは、一旦、印刷領域を削除し、自動改行による印刷領域からページ数を取り、次に、1ページの行数を取り出しています。次に貼り付けた時に、データが切れる場合もあるので、それをもう一度、１ページの行数とページ数で掛けて、その位置を設定し直し、再度、次のページの最初の行を取り出しています。

今のところ、A列の最後尾に対して、印刷範囲を取っていますので、不用意に下の場所にあると、それを印刷領域にまで入れてしまいます。それを注意して行ってください。

こちらでは、上手くできましたが、これは、かなり難しい種類のマクロです。
#1 のhana-hana3 さんので上手く行きましたら、こちらのは、参考にするだけで結構です。
いずれにしても、Ver 4 マクロ関数以外には、この方法は思いつきませんでした。

'貼り付けは、標準モジュールをお勧めします。
'-------------------------------------------------------
Sub AddPages()
　Dim i As Integer
　Dim oPageRow As Integer　'元のページ行数
　Dim aPageRow As Integer　'再度取得したページ行数
　Dim PageCount As Integer　'ページ数
　'注意：これは、A:X までの列が、１ページに収まることを想定して作られています。
　
　Const PAGE_EXT As String = "A1:X40" '１ページの大きさ
　Const MYSHEET As String = "Sheet1" 'コピー元シート
　
　On Error Resume Next
　
　With ActiveSheet
　　.PageSetup.PrintArea = ""
　　PageCount = ExecuteExcel4Macro("COLUMNS(GET.DOCUMENT(64))") + 1
　　If PageCount = 0 Then PageCount = 1
　　oPageRow = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),0,0)")
　　If oPageRow = 0 Then oPageRow = Range(PAGE_EXT).Rows.Count 'ダミー
　　i = PageCount * oPageRow - 1 '次のページの開始位置を探す
　　
　　'貼り付けた後の状態のダミーを作る
　　.PageSetup.PrintArea = .Range(PAGE_EXT).Resize(Range(PAGE_EXT).Rows.Count * (PageCount + 1)).Address
　　 aPageRow = ExecuteExcel4Macro("INDEX(GET.DOCUMENT(64),0,0)")
　　If oPageRow <> aPageRow Then
　　　i = PageCount * aPageRow　'次のページの開始位置を探す
　　End If
　　
　　Worksheets(MYSHEET).Range(PAGE_EXT).Copy .Cells(i, 1)
　　.PageSetup.PrintArea = .Range("A1", .Range("A65536").End(xlUp)).Resize(, 24).Address
　End With
　
　On Error GoTo 0
End Sub

hana-hana3 · Answer

＞『実行時エラー９　インデックスが有効範囲にありません』

どのような方法で実行されていますか？

貼付け先のセル（左上）は選択されていますか？

【Excel】マクロでページを追加することはできますか？

選択した位置(ActiveCell)に「ひな形」をコピーします。

この回答への補足

こんにちは。

こんにちは。

＞『実行時エラー９ インデックスが有効範囲にありません』

この回答への補足

似たような質問が見つかりました

このQ&Aを見た人はこんなQ&Aも見ています

関連するカテゴリからQ&Aを探す

このQ&Aを見た人がよく見るQ&A

デイリーランキングこのカテゴリの人気デイリーQ&Aランキング

マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング

＞『実行時エラー９　インデックスが有効範囲にありません』