Question

如何使用VBA将页面设置（包括RightHeaderPicture从工作表复制到另一个）？有人可以帮我吗？问候，安东尼特伦斯

Answer 1

有点赤裸裸但你完成时会得到这个想法！

显然没有简单的方法可以完整地复制PageSetup对象，因此，假设工作簿处于打开状态，请尝试以下操作：

Sub cpyPS()
Dim wsFrom As Worksheet, wsTO As Worksheet

Set wsFrom = Sheets("From")
Set wsTO = Sheets("To")

    With wsTO.PageSetup
        'there are nearly 50 properties
        .AlignMarginsHeaderFooter = wsFrom.PageSetup.AlignMarginsHeaderFooter
        .BlackAndWhite = wsFrom.PageSetup.BlackAndWhite
        .BottomMargin = wsFrom.PageSetup.BottomMargin
        '
        '
        .LeftMargin = wsFrom.PageSetup.LeftMargin
        '
        '
        .Orientation = wsFrom.PageSetup.Orientation
        '
        '
        .PaperSize = wsFrom.PageSetup.PaperSize

        .RightHeaderPicture.Filename = wsFrom.PageSetup.RightHeaderPicture.Filename
        .RightMargin = wsFrom.PageSetup.RightMargin
        '
        '
        .TopMargin = wsFrom.PageSetup.TopMargin
        '
        '
        .Zoom = wsFrom.PageSetup.Zoom
    End With

End Sub

要考虑的完整属性列表是provided here。

没关系，或者把它作为一个函数写一次并回发给大家使用？

如果您可以这样做，您可以随时复制整张表并重命名。这些房产将按原样“接管”。

Answer 2

基于barryleajo的回答，我想到了以下代码：

（注释区域导致运行时错误）

Sub copyPageSetup(fromSheet, toSheet)
With toSheet.PageSetup
    .AlignMarginsHeaderFooter = fromSheet.PageSetup.AlignMarginsHeaderFooter
'    .Application = fromSheet.PageSetup.Application
    .BlackAndWhite = fromSheet.PageSetup.BlackAndWhite
    .BottomMargin = fromSheet.PageSetup.BottomMargin
    .CenterFooter = fromSheet.PageSetup.CenterFooter
'   .CenterFooterPicture = fromSheet.PageSetup.CenterFooterPicture
    .CenterHeader = fromSheet.PageSetup.CenterHeader
'   .CenterHeaderPicture = fromSheet.PageSetup.CenterHeaderPicture
    .CenterHorizontally = fromSheet.PageSetup.CenterHorizontally
    .CenterVertically = fromSheet.PageSetup.CenterVertically
'   .Creator = fromSheet.PageSetup.Creator
    .DifferentFirstPageHeaderFooter = fromSheet.PageSetup.DifferentFirstPageHeaderFooter
    .Draft = fromSheet.PageSetup.Draft
'    .EvenPage = fromSheet.PageSetup.EvenPage
'    .FirstPage = fromSheet.PageSetup.FirstPage
    .FirstPageNumber = fromSheet.PageSetup.FirstPageNumber
    .FitToPagesTall = fromSheet.PageSetup.FitToPagesTall
    .FitToPagesWide = fromSheet.PageSetup.FitToPagesWide
    .FooterMargin = fromSheet.PageSetup.FooterMargin
    .HeaderMargin = fromSheet.PageSetup.HeaderMargin
    .LeftFooter = fromSheet.PageSetup.LeftFooter
'    .LeftFooterPicture = fromSheet.PageSetup.LeftFooterPicture
    .LeftHeader = fromSheet.PageSetup.LeftHeader
'    .LeftHeaderPicture = fromSheet.PageSetup.LeftHeaderPicture
    .LeftMargin = fromSheet.PageSetup.LeftMargin
    .OddAndEvenPagesHeaderFooter = fromSheet.PageSetup.OddAndEvenPagesHeaderFooter
    .Order = fromSheet.PageSetup.Order
    .Orientation = fromSheet.PageSetup.Orientation
'    .Pages = fromSheet.PageSetup.Pages
    .PaperSize = fromSheet.PageSetup.PaperSize
'    .Parent = fromSheet.PageSetup.Parent
    .PrintArea = fromSheet.PageSetup.PrintArea
    .PrintComments = fromSheet.PageSetup.PrintComments
    .PrintErrors = fromSheet.PageSetup.PrintErrors
    .PrintGridlines = fromSheet.PageSetup.PrintGridlines
    .PrintHeadings = fromSheet.PageSetup.PrintHeadings
    .PrintNotes = fromSheet.PageSetup.PrintNotes
    .PrintQuality = fromSheet.PageSetup.PrintQuality
    .PrintTitleColumns = fromSheet.PageSetup.PrintTitleColumns
    .PrintTitleRows = fromSheet.PageSetup.PrintTitleRows
    .RightFooter = fromSheet.PageSetup.RightFooter
'    .RightFooterPicture = fromSheet.PageSetup.RightFooterPicture
    .RightHeader = fromSheet.PageSetup.RightHeader
'    .RightHeaderPicture = fromSheet.PageSetup.RightHeaderPicture
    .RightMargin = fromSheet.PageSetup.RightMargin
    .ScaleWithDocHeaderFooter = fromSheet.PageSetup.ScaleWithDocHeaderFooter
    .TopMargin = fromSheet.PageSetup.TopMargin
    .Zoom = fromSheet.PageSetup.Zoom
    End With
End Sub

如何使用VBA将页面设置从工作表复制到另一个工作表

2 个答案: