如何在 Excel VBA 代码上设置固定边距（PDF 打印为 2 页而不是 1 页）

Question

我有一个 Excel 文件，其中有一个“生成 PDF”按钮，该按钮运行宏以将某个工作表（我们称之为“QUOTE”）打印到 PDF 中。这张表的页边距非常有限，并且在我的计算机中创建的 PDF 具有完美的结构：所有内容都很好地包含在一页中。然而，在其他一些计算机中，当创建 PDF 时，所有内容都无法放入一页，而是会创建包含一些内容的第二页。这是代码（包括通过限制边距来解决此问题的尝试）：

Sub Excel_Export_Proposal()

Dim wb As Workbook: Set wb = ThisWorkbook
Dim wsCOTIZACION As Worksheet
Dim Proposalname As String
Dim iVis As XlSheetVisibility
Dim xlName As Excel.Name
Dim FolderPath As String
Dim myRange As String

Set wsQUOTE = ThisWorkbook.Sheets("QUOTE")

FolderPath = ActiveWorkbook.Path & "\"


Proposalname = "Quote for " & CStr(Range("B2").Value)

wsQUOTE.PageSetup.PrintArea = myRange
With wsQUOTE.PageSetup
.FitToPagesTall = 1
.FitToPagesWide = False
.Zoom = False
.LeftMargin = Application.InchesToPoints(0.7)
.RightMargin = Application.InchesToPoints(0.4)
.BottomMargin = Application.InchesToPoints(0.75)
.TopMargin = Application.InchesToPoints(0.75)


End With

'Proposal
Application.ScreenUpdating = False
wb.Unprotect
With wsQUOTE
iVis = .Visible
.Visible = xlSheetVisible
.ExportAsFixedFormat Type:=xlTypePDF, _
                     Filename:=ActiveWorkbook.Path & "\" & Proposalname & ".pdf", _
                     Quality:=xlQualityStandard, _
                     IncludeDocProperties:=True, _
                     IgnorePrintAreas:=True, _
                     OpenAfterPublish:=True


.Visible = iVis

wsQUOTE.Activate


End With



wb.Protect 
Application.ScreenUpdating = True
End Sub

有人可以帮我解决这个问题吗？我希望无论生成的计算机或软件如何，我们都能完美地打印该表...

Answer 1

为了使该过程始终Excel_Export_Proposal包含PrintingArea在一页中，应进行以下调整：

1. 正确设置打印区域：
   此行设置打印区域： wsQUOTE.PageSetup.PrintArea = myRange
   但是，此行之前没有为变量赋值myRange，因此PrintArea设置为""相当于将其设置为整个UsedRange纸张wsQUOTE。

2. 为了确保整个PrintArea打印在一页上，必须将FitToPagesTall和设置为 1 替换为 并删除，因为设置和为 1后不起作用FitToPagesWide
.FitToPagesWide = False.FitToPagesWide = 1
.Zoom = FalseFitToPagesTallFitToPagesWide

3. 为了确保该ExportAsFixedFormat方法使用目标 Excel 文件中定义的打印区域，请将IgnorePrintAreas参数设置为False。
   将此行替换IgnorePrintAreas:=True, _为此行IgnorePrintAreas:=False, _

以下是修改后的程序：

    Sub Excel_Export_Proposal_Revised()
    Dim wb As Workbook, wsQuote As Worksheet
    Dim myRange As String, Proposalname As String, FolderPath As String
    Dim iVis As XlSheetVisibility

        Set wb = ThisWorkbook
        Set wsQuote = wb.Sheets("QUOTE")
        FolderPath = wb.Path & "\"
        Proposalname = "Quote for " & wsQuote.Range("B2").Value2

        'Update myRange with the address of the range to be printed
        myRange = "$B$2:$O$58"  'Change as required

        Application.ScreenUpdating = False

        With wsQuote.PageSetup
            .PrintArea = myRange
            .FitToPagesTall = 1
            .FitToPagesWide = 1     'Set FitToPagesWide to 1
            .LeftMargin = Application.InchesToPoints(0.7)
            .RightMargin = Application.InchesToPoints(0.4)
            .TopMargin = Application.InchesToPoints(0.75)
            .BottomMargin = Application.InchesToPoints(0.75)
        End With

        'Proposal
        wb.Unprotect
        With wsQuote
            iVis = .Visible
            .Visible = xlSheetVisible
            .Activate
            .ExportAsFixedFormat Type:=xlTypePDF, _
                Filename:=FolderPath & Proposalname & ".pdf", _
                Quality:=xlQualityStandard, IncludeDocProperties:=True, _
                IgnorePrintAreas:=False, OpenAfterPublish:=True
            .Visible = iVis
        End With
        wb.Protect

        Application.ScreenUpdating = True

        End Sub

有关所用资源的更多信息，请参阅以下页面：

Worksheet.ExportAsFixedFormat 方法 (Excel)
PageSetup 对象 (Excel)