Attribute VB_Name = "mdlCloneWS"
Option Explicit

'モジュールレベル変数宣言

'***ページ
    '***印刷の向き
        Private myOrientation As Long
    '***拡大縮小印刷
        Private myZoom As Variant               '拡大／縮小
        Private myFitToPagesWide As Variant     '横ページ数
        Private myFitToPagesTall As Variant     '縦ページ数
    '***用紙サイズ
        Private myPaperSize As Long
    '***印刷品質
        Private myPrintQuality As Variant
    '***先頭ページ番号
        Private myFirstPageNumber As Long

'***余白
    '***上
        Private myTopMargin As Double
    '***下
        Private myBottomMargin As Double
    '***左
        Private myLeftMargin As Double
    '***右
        Private myRightMargin As Double
    '***ヘッダ
        Private myHeaderMargin As Double
    '***フッタ
        Private myFooterMargin As Double
    '***ページ中央
        Private myCenterHorizontally As Boolean '水平
        Private myCenterVertically As Boolean   '垂直
    '***ページ余白にあわせてヘッダ・フッタを配置
        Private myAlignMarginsHeaderFooter As Boolean

'***ヘッダ／フッタ
    '***ヘッダ
        Private myLeftHeader As String          '左側
        Private myCenterHeader As String        '中央部
        Private myRightHeader As String         '右側
    '***フッタ
        Private myLeftFooter As String          '左側
        Private myCenterFooter As String        '中央部
        Private myRightFooter As String         '右側
    '***先頭ページに別のヘッダーおよびフッターを設定
        Private myDifferentFirstPageHeaderFooter As Boolean
        '先頭ページ
        Private myFirstPage As Variant
    '***奇数ページと偶数ページに異なるヘッダーとフッター
        Private myOddAndEvenPagesHeaderFooter
        '偶数ページ
        Private myEvenPage As Variant
    '***ヘッダーとフッターのサイズが文書に合わせて変更されるかどうか
        Private myScaleWithDocHeaderFooter As Boolean

'***シート
    '***印刷範囲
        Private myPrintArea As String
    '***印刷タイトル
        Private myPrintTitleRows As String      '行のタイトル
        Private myPrintTitleColumns As String   '列のタイトル
    '***印刷
        Private myPrintGridlines As Boolean     '枠線
        Private myPrintHeadings As Boolean      '行列番号
        Private myBlackAndWhite As Boolean      '白黒印刷
        Private myPrintComments As Long         'コメント
        Private myPrintNotes As Boolean         'コメント（セル内）
        Private myDraft As Boolean              '簡易印刷
    '***ページの方向
        Private myOrder As Long                 '(左から右・上から下)
        
Private Property Let Switch(ByVal Flag As Boolean)
  With Application
    .ScreenUpdating = Not Flag
    .PrintCommunication = Not Flag
  End With
End Property

Public Sub S_CloneWS()
  Switch = True
  
  On Error GoTo HandleError
  
  Dim CopyWS As String: CopyWS = ActiveSheet.Name
  Worksheets.Add.Move After:=Worksheets(CopyWS)
  
  Dim PasteWS As String: PasteWS = CopyWS & "(0)"
  ActiveSheet.Name = PasteWS
  
  Call S_CopyPageSetup(CopyWS)
  Call S_PastePageSetup(PasteWS)
  Call S_CopyWSFormat(CopyWS, PasteWS)
  
  Worksheets(PasteWS).Cells(1, 1).Select
  
  On Error GoTo 0
  
  Switch = False
  
  Exit Sub
HandleError:
  Dim myErr  As String
  
  myErr = "エラー番号：" & Err.Number & vbCrLf & _
          "エラー内容：" & Err.Description
  
  MsgBox myErr, vbExclamation, "エラー発生！"
End Sub

Private Sub S_CopyPageSetup(ByVal WS As String)
  On Error Resume Next
  
  With Worksheets(WS).PageSetup
    myPrintTitleRows = .PrintTitleRows
    myPrintTitleColumns = .PrintTitleColumns
    myPrintArea = .PrintArea
    
    myLeftHeader = .LeftHeader
    myCenterHeader = .CenterHeader
    myRightHeader = .RightHeader
    myLeftFooter = .LeftFooter
    myCenterFooter = .CenterFooter
    myRightFooter = .RightFooter
    myDifferentFirstPageHeaderFooter _
      = .DifferentFirstPageHeaderFooter
    myFirstPage = .FirstPage
    myOddAndEvenPagesHeaderFooter _
      = .OddAndEvenPagesHeaderFooter
    myOddAndEvenPagesHeaderFooter = .OddAndEvenPagesHeaderFooter
    myEvenPage = .EvenPage
    myScaleWithDocHeaderFooter = .ScaleWithDocHeaderFooter
    
    myLeftMargin = .LeftMargin
    myRightMargin = .RightMargin
    myTopMargin = .TopMargin
    myBottomMargin = .BottomMargin
    myHeaderMargin = .HeaderMargin
    myFooterMargin = .FooterMargin
    myAlignMarginsHeaderFooter = .AlignMarginsHeaderFooter
    
    myPrintHeadings = .PrintHeadings
    myPrintGridlines = .PrintGridlines
    myPrintComments = .PrintComments
    myPrintNotes = .PrintNotes
    myPrintQuality = .PrintQuality
    myCenterHorizontally = .CenterHorizontally
    myCenterVertically = .CenterVertically
    
    myOrientation = .Orientation
    myDraft = .Draft
    myPaperSize = .PaperSize
    myFirstPageNumber = .FirstPageNumber
    myOrder = .Order
    myBlackAndWhite = .BlackAndWhite
    
    myZoom = .Zoom
    myFitToPagesWide = .FitToPagesWide
    myFitToPagesTall = .FitToPagesTall
  End With
  
  On Error GoTo 0
End Sub

Private Sub S_PastePageSetup(ByVal WS As String)
  On Error Resume Next
  
  With Worksheets(WS).PageSetup
    .PrintTitleRows = myPrintTitleRows
    .PrintTitleColumns = myPrintTitleColumns
    .PrintArea = myPrintArea
    
    .LeftHeader = myLeftHeader
    .CenterHeader = myCenterHeader
    .RightHeader = myRightHeader
    .LeftFooter = myLeftFooter
    .CenterFooter = myCenterFooter
    .RightFooter = myRightFooter
    .DifferentFirstPageHeaderFooter _
      = myDifferentFirstPageHeaderFooter
    .FirstPage = myFirstPage
    .OddAndEvenPagesHeaderFooter = myOddAndEvenPagesHeaderFooter
    .EvenPage = myEvenPage
    .ScaleWithDocHeaderFooter = myScaleWithDocHeaderFooter
    
    .LeftMargin = myLeftMargin
    .RightMargin = myRightMargin
    .TopMargin = myTopMargin
    .BottomMargin = myBottomMargin
    .HeaderMargin = myHeaderMargin
    .FooterMargin = myFooterMargin
    .AlignMarginsHeaderFooter = myAlignMarginsHeaderFooter

    .PrintHeadings = myPrintHeadings
    .PrintGridlines = myPrintGridlines
    .PrintComments = myPrintComments
    .PrintNotes = myPrintNotes
    .PrintQuality = myPrintQuality
    .CenterHorizontally = myCenterHorizontally
    .CenterVertically = myCenterVertically
    
    .Orientation = myOrientation
    .Draft = myDraft
    .PaperSize = myPaperSize
    .FirstPageNumber = myFirstPageNumber
    .Order = myOrder
    .BlackAndWhite = myBlackAndWhite
    
    .Zoom = myZoom
    .FitToPagesWide = myFitToPagesWide
    .FitToPagesTall = myFitToPagesTall
  End With
  
  On Error GoTo 0
End Sub

Private Sub S_CopyWSFormat(ByVal OriginalWS As String, _
                           ByVal TargetWS As String)
  On Error Resume Next
  
  Worksheets(OriginalWS).Activate
  
  Dim myZoom  As Variant: myZoom = ActiveWindow.Zoom
  
  Cells.Copy
  
  Worksheets(TargetWS).Activate
  
  Cells(1, 1).PasteSpecial Paste:=xlFormats
  
  ActiveWindow.Zoom = myZoom
End Sub