vba - 如何在 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

为了始终在一页中包含 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)