Excel VBA テクニック集
印字書式のコピー貼付





Excel VBA テクニック集




コピー貼付、これはセルやシートなどが対象と思われますが、印字のための頁設定もコピーができます。
VBAで操作ができる、かつ設定可能プロパティのみがコピーできます。プリンター特有のプロパティはコピーできません。

使い方は、編集(コピー・貼付)の考え方の、「パターン2又は3」の「マクロ専用ファイル」によるマクロ実行に、下記コードを入れます。
    Dim Row_Frm As Long
    Dim Column_Frm As Integer 
    Dim J As Integer
    On Error Resume Next
    
    'タイトル行
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintTitleRows _
        = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintTitleRows
    Err.Clear
    'タイトル列
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintTitleColumns _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintTitleColumns
    Err.Clear
    '印刷する範囲
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintArea _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintArea
    Err.Clear
    '左側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.LeftHeader _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.LeftHeader
    Err.Clear
    '中央のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.CenterHeader _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.CenterHeader
    Err.Clear
    '右側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.RightHeader _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.RightHeader
    Err.Clear
    '左側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.LeftFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.LeftFooter
    Err.Clear
    '中央のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.CenterFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.CenterFooter
    Err.Clear
    '右側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.RightFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.RightFooter
    Err.Clear
    '左余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.LeftMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.LeftMargin
    Err.Clear
    '右余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.RightMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.RightMargin
    Err.Clear
    上余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.TopMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.TopMargin
    Err.Clear
    下余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.BottomMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.BottomMargin
    Err.Clear
    'ヘッダーの余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.HeaderMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.HeaderMargin
    Err.Clear
    'フッターの余白
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FooterMargin _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FooterMargin
    Err.Clear
    '行と列の番号を印刷
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintHeadings _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintHeadings
    Err.Clear
    'セルの枠線を印刷
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintGridlines _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintGridlines
    Err.Clear
    'コメントの印刷方法
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintComments _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintComments
    Err.Clear
    'レイアウトを水平方向で中央
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.CenterHorizontally _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.CenterHorizontally
    Err.Clear
    'レイアウトを垂直方向で中央
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.CenterVertically _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.CenterVertically
    Err.Clear
    '印刷の向き(縦と横)
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.Orientation _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.Orientation
    Err.Clear
    'グラフィックスを印刷
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.Draft _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.Draft
    Err.Clear
    '用紙サイズ
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PaperSize _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PaperSize
    Err.Clear
    '先頭ページに使用するページ番号
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPageNumber _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPageNumber
    Err.Clear
    '大きいワークシートを複数ページに分けて印刷するとき
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.Order _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.Order
    Err.Clear
    '白黒印刷
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.BlackAndWhite _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.BlackAndWhite
    Err.Clear
    '拡大率・縮小率
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.Zoom _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.Zoom
    Err.Clear
    '横何ページ分で収めるかを示す値
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FitToPagesWide _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FitToPagesWide
    Err.Clear
    '縦何ページ分で収めるかを示す値
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FitToPagesTall _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FitToPagesTall
    Err.Clear
    'エラーセルの印刷の種類
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.PrintErrors _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.PrintErrors
    Err.Clear
    '奇数・偶数頁ごとヘッダー設定
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.OddAndEvenPagesHeaderFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.OddAndEvenPagesHeaderFooter
    Err.Clear
    '先頭頁に特殊なヘッダー設定
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.DifferentFirstPageHeaderFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.DifferentFirstPageHeaderFooter
    Err.Clear
    '文書に合わせてヘッダーサイズ゙を変更
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.ScaleWithDocHeaderFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.ScaleWithDocHeaderFooter
    Err.Clear
    'ヘッダーをページ設定の余白を使用して揃える
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.AlignMarginsHeaderFooter _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.AlignMarginsHeaderFooter
    Err.Clear
    '(偶数頁)左側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.LeftHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.LeftHeader.Text
    Err.Clear
    '(偶数頁)中央のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.CenterHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.CenterHeader.Text
    Err.Clear
    '(偶数頁)右側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.RightHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.RightHeader.Text
    Err.Clear
    '(偶数頁)左側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.LeftFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.LeftFooter.Text
    Err.Clear
    '(偶数頁)中央のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.CenterFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.CenterFooter.Text
    Err.Clear
    '(偶数頁)右側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.EvenPage.RightFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.EvenPage.RightFooter.Text
    Err.Clear
    '(最初の頁)左側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.LeftHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.LeftHeader.Text
    Err.Clear
    '(最初の頁)中央のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.CenterHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.CenterHeader.Text
    Err.Clear
    '(最初の頁)右側のヘッダー
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.RightHeader.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.RightHeader.Text
    Err.Clear
    '(最初の頁)左側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.LeftFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.LeftFooter.Text
    Err.Clear
    '(最初の頁)中央のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.CenterFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.CenterFooter.Text
    Err.Clear
    '(最初の頁)右側のフッター
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).PageSetup.FirstPage.RightFooter.Text _
                = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).PageSetup.FirstPage.RightFooter.Text
    Err.Clear
    '「表示」を「改ページプレビュー」に切り替える
    Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).Activate
    DoEvents
    Excel_App.ActiveWindow.View = xlPageBreakPreview

    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).Activate
    DoEvents
    Excel_App.ActiveWindow.View = xlPageBreakPreview
    Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).ResetAllPageBreaks

    DoEvents
    '横の改頁
    '水平の改ページ件数 > 0 ならば
    If Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).HPageBreaks.Count > 0 Then
        For J = 1 To Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).HPageBreaks.Count
            '上から数えてJ番目の改行位置
            Row_Frm = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).HPageBreaks(J).Location.Row
            'J番目の改行が、自動ではなくユーザーが定めた改行の場合
            If Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).Rows(Row_Frm).PageBreak = xlPageBreakManual Then
                '貼付先の同じ行に、手動改行を設定する
                Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).Rows(Row_Frm).PageBreak = xlPageBreakManual
                End If
            DoEvents
            Next J
        End If
    Err.Clear
    '縦の改頁
    '垂直の改ページ件数 > 0 ならば
    If Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).VPageBreaks.Count > 0 Then
        For J = 1 To Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).VPageBreaks.Count
            '左から数えてJ番目の改行位置
            Column_Frm = Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).VPageBreaks(J).Location.Column
            'J番目の改行が、自動ではなくユーザーが定めた改行の場合
            If Excel_App.Workbooks(CopyBook_Frm).Worksheets(CopySheet_Frm).Columns(Column_Frm).PageBreak = xlPageBreakManual Then
                '貼付先の同じ列に、手動改行を設定する
                Excel_App.Workbooks(PasteBook_Frm).Worksheets(PasteSheet_Frm).Columns(Column_Frm).PageBreak = xlPageBreakManual
                End If
            DoEvents
            Next J
        End If
    Err.Clear

「こだわりハウス」写真館| 数学公式集| ピンポイントストリートビュー| FaceBook| Excel Vba テクニック集| Excel 計算式解析・他解析| 富山の建築家| Excel 計算式解析・他解析| 積分の定義・積分の記号の意味の研究|