MW211 EXIT

devlog
ExcelVBA/マクロ抜きシート複写
2018年02月28日
シートを複写すると漏れなくシートのマクロも付いてくる。
それを除去したいという場合、コピー後にマクロを削除するのは困難なようなので
(自由のソースコードを改変できることになり、セキュリティ的に厳しい)
新規シートを追加し、マクロ以外を地道にコピーする方が(遠回りだけど)近道なようだ。
以下その関数。
┌──────────────────────────────────────┐
│Sub マクロ抜きシート複写(ByVal 入力シート As Worksheet, _                   │
│                         ByVal 出力シート As Worksheet)                     │
│    Dim 改頁 As Variant, 表示倍率 As Long                                   │
│    '-----------------------------------------------------------------------│
│    '  コピー                                                               │
│    '-----------------------------------------------------------------------│
│    入力シート.Cells.Copy  ' コピー                                         │
│    With 出力シート.Cells(1, 1)                                             │
│        .PasteSpecial Paste:=xlValues   ' 値貼り付け                        │
│        .PasteSpecial Paste:=xlFormats  ' 書式貼り付け                      │
│        .Select                                                             │
│    End With                                                                │
│    '-----------------------------------------------------------------------│
│    '  印刷設定の複写                                                       │
│    '-----------------------------------------------------------------------│
│    Call 複写PageSetup(入力シート.PageSetup, 出力シート.PageSetup)          │
│    '-----------------------------------------------------------------------│
│    '  改頁位置の複写                                                       │
│    '-----------------------------------------------------------------------│
│    For Each 改頁 In 入力シート.HPageBreaks                                 │
│        出力シート.HPageBreaks.Add 改頁.Location.Rows                       │
│    Next 改頁                                                               │
│    '-----------------------------------------------------------------------│
│    '  表示倍率の複写                                                       │
│    '-----------------------------------------------------------------------│
│    入力シート.Select:  表示倍率 = ActiveWindow.Zoom                        │
│    出力シート.Select:  ActiveWindow.Zoom = 表示倍率                        │
│    '-----------------------------------------------------------------------│
│    '  クリップボードのクリア                                               │
│    '-----------------------------------------------------------------------│
│    Application.CutCopyMode = False                                         │
│    ' 上記で解消できないものは、全セル選択から一セル選択に変更で対応        │
│    ' →「図が大きすぎます。」エラー対策                                    │
│    入力シート.Cells(1, 1).Copy                                             │
│End Sub                                                                     │
├──────────────────────────────────────┤
│Private Sub 複写PageSetup(ByVal 入力 As Object, _                           │
│                          ByVal 出力 As Object)                             │
│    With 出力                                                               │
│        .AlignMarginsHeaderFooter = 入力.AlignMarginsHeaderFooter           │
│        .BlackAndWhite = 入力.BlackAndWhite                                 │
│        .BottomMargin = 入力.BottomMargin                                   │
│        .CenterFooter = 入力.CenterFooter                                   │
│        .CenterHeader = 入力.CenterHeader                                   │
│        .CenterHorizontally = 入力.CenterHorizontally                       │
│        .CenterVertically = 入力.CenterVertically                           │
│        .DifferentFirstPageHeaderFooter = 入力.DifferentFirstPageHeaderFooter
│        .Draft = 入力.Draft                                                 │
│        .FirstPageNumber = 入力.FirstPageNumber                             │
│        .FitToPagesTall = 入力.FitToPagesTall                               │
│        .FitToPagesWide = 入力.FitToPagesWide                               │
│        .FooterMargin = 入力.FooterMargin                                   │
│        .HeaderMargin = 入力.HeaderMargin                                   │
│        .LeftFooter = 入力.LeftFooter                                       │
│        .LeftHeader = 入力.LeftHeader                                       │
│        .LeftMargin = 入力.LeftMargin                                       │
│        .OddAndEvenPagesHeaderFooter = 入力.OddAndEvenPagesHeaderFooter     │
│        .Order = 入力.Order                                                 │
│        .Orientation = 入力.Orientation                                     │
│        .PaperSize = 入力.PaperSize                                         │
│        .PrintArea = 入力.PrintArea                                         │
│        .PrintComments = 入力.PrintComments                                 │
│        .PrintErrors = 入力.PrintErrors                                     │
│        .PrintGridlines = 入力.PrintGridlines                               │
│        .PrintHeadings = 入力.PrintHeadings                                 │
│        .PrintNotes = 入力.PrintNotes                                       │
│        .PrintQuality = 入力.PrintQuality                                   │
│        .PrintTitleColumns = 入力.PrintTitleColumns                         │
│        .PrintTitleRows = 入力.PrintTitleRows                               │
│        .RightFooter = 入力.RightFooter                                     │
│        .RightHeader = 入力.RightHeader                                     │
│        .RightMargin = 入力.RightMargin                                     │
│        .ScaleWithDocHeaderFooter = 入力.ScaleWithDocHeaderFooter           │
│        .TopMargin = 入力.TopMargin                                         │
│        .Zoom = 入力.Zoom                                                   │
│        ' 以下省略(複雑なので)                                              │
│''''''''.Application = 入力.Application                                     │
│''''''''.CenterFooterPicture = 入力.CenterFooterPicture                     │
│''''''''.CenterHeaderPicture = 入力.CenterHeaderPicture                     │
│''''''''.Creator = 入力.Creator                                             │
│''''''''.EvenPage = 入力.EvenPage                                           │
│''''''''.FirstPage = 入力.FirstPage                                         │
│''''''''.LeftFooterPicture = 入力.LeftFooterPicture                         │
│''''''''.LeftHeaderPicture = 入力.LeftHeaderPicture                         │
│''''''''.Pages = 入力.Pages                                                 │
│''''''''.Parent = 入力.Parent                                               │
│''''''''.RightFooterPicture = 入力.RightFooterPicture                       │
│''''''''.RightHeaderPicture = 入力.RightHeaderPicture                       │
│    End With                                                                │
│End Sub                                                                     │
└──────────────────────────────────────┘
複写PageSetup()の部分(PageSetupオブジェクト配下プロパティの全コピー)が、
もっと簡単にできればいいのだが…。

オブジェクト配下プロパティの全コピーの方法はみつからないようだ。
分類:ExcelVBA