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

質問

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

回答No.1

hana-hana3 · ベストアンサー

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

Sub cpy()
Sheets("Sheet1").Range("A1:X40").Copy ActiveCell
End Sub

補足

早々の回答ありがとうございます。
早速試してみたのですが
『実行時エラー９　インデックスが有効範囲にありません』
というダイアログが表示されてエラーが出てしまいました。

回答No.4

KenKen_SP

こんにちは。

> もともと、空き行を想定していたりすると、レイアウトが崩れたりするので、
> あまり好まれません。

確かにそうですね^^;

では、空行をパラメータとしてもっておき、ページの切れ目ではなく、ページの
頭に改ページを挿入するというロジックでどうですか？

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 ご回答が汎用的・シンプルで一番良い
' # と思います。ご参考までということで。

お礼

KenKen_SPさん、おはようございます。
詳しいご回答ありがとうございます<(_ _)>

#3のWendy02さんのご指摘で、確認がてらシート名を入力しなおしたところ、うまくいきました。KenKen_SPさんのおっしゃるとおり、#1 ご回答が汎用的・シンプルで一番良いとのことなので、今回は#1のhana-hana3さんのコードを使わせていただきました。

KenKen_SPさんが記載してくださったコードは今後の参考にさせていただきます。
ありがとうございました。

回答No.3

Wendy02

こんにちは。

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

それは、実際のシート名と、マクロの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

お礼

Wendy02さん、おはようございます。
いつもご丁寧な回答ありがとうございます。

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

>それは、実際のシート名と、マクロのSheets("Sheet1") が合っていないからではないでしょうか？インデックスというのは、シート名のことのはずですから。

とのご指摘がありましたので、シート名を再入力してみましたところ、うまくいきましたので、Wendy02さんのおっしゃるとおり、#1 のhana-hana3 さんのコードを使わせていただきました。
これに、アクティブセルから39行下までを印刷範囲に指定するコードを書き加えて、無事完成しました。

今回、Wendy02さんが記載してくださったコードはとってもムズカシイですね。。。(@_@)
今後の参考にさせていただきます。ありがとうございました。

回答No.2

hana-hana3

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

どのような方法で実行されていますか？

貼付け先のセル（左上）は選択されていますか？

お礼

No.3のWendy02さんの回答より
>>『実行時エラー９　インデックスが有効範囲にありません』

>それは、実際のシート名と、マクロのSheets("Sheet1") が合っていないからではないでしょうか？インデックスというのは、シート名のことのはずですから。

とご指摘がありましたので、ひな形(Sheet1)のシート名を再度入力しなおして、コードの方も入力しなおしてみたところ、うまくいきましたので、シート名が一致していなかったようです。
『インデックスが有効範囲にありません』というメッセージがどういうことを意味しているのかがわかりませんでしたので、お手数かけて申し訳ありませんでした。ありがとうございました。

補足

>どのような方法で実行されていますか？
標準モジュールに教えていただいたコードを書いて、「Alt」＋「F8」キーでマクロを実行しました。

>貼付け先のセル（左上）は選択されていますか？
左上のセルを選択した状態でマクロを実行しました。

お手数かけて申し訳ありませんが、よろしくお願いします。