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

Question

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

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

为了在一个页面中包含PrintingArea 的过程Excel_Export_Proposal，应始终应用以下调整：

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

2. 为确保将整个 PrintArea 打印在一页中，FitToPagesTall 和 FitToPagesWide 必须设置为 1
   将.FitToPagesWide = False 替换为.FitToPagesWide = 1
   并删除.Zoom = False，因为将FitToPagesTall和FitToPagesWide设置为1后没有效果

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 Method (Excel)
PageSetup Object (Excel)