时间戳

首页 > 解决方案 > VBA Excel忽略PrintArea Pdf

vba - VBA Excel忽略PrintArea Pdf

问题描述

我有 250 个 excel 文档，我尝试在其中打印一张 pdf 表格。如果我手动执行，它将是 4 页，但如果我使用我的代码，它将是 7 页。

这就像它忽略了打印区域，并制作了几个空白页。

你们中的任何人都可以找出错误吗？

    Dim wb As Workbook
    Dim xExtension As String: xExtension = "*.xls*"
    Dim xFolder As String: xFolder = [MailFolder]
    Dim xFile As String: xFile = Dir(xFolder & xExtension) 'DIR gets the first file of the folder
    Dim Rng As Range: Set Rng = Range("A1")
    Dim s As String
    

    
    Do While xFile <> "" 'Loop through all files in a folder until DIR cannot find anymore
        
Set wb = Workbooks.Open(xFolder & xFile): wb.Activate
    
        
        Call WorksheetsToPDF(wb, "F:\VBA\PDF\Udlejning\" & CleanFileName("Police - " & "2021 -" & [KompletPoliceNr] & " - " & [Forsikringstager]) & ".pdf", "Certifikat")
        'Call WorksheetsToPDF(wb, "F:\VBA\KF Begæringer\" & CleanFileName("KF Begæring-2021-" & [KompletPoliceNr] & "-" & [Forsikringstager]) & ".pdf", "Police")
        
        wb.Close savechanges:=False
        xFile = Dir()
    Loop
    
    End Sub

Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray Arr() As Variant)
    wb.Sheets(Arr()).Select
    Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False

End Sub


Private Function GetNextAvailableFilename(ByVal xPath As String) As String
    With CreateObject("Scripting.FileSystemObject")
        Dim strFolder As String, strBaseName As String, strExt As String, i As Long
        strFolder = .GetParentFolderName(xPath)
        strBaseName = .GetBaseName(xPath)
        strExt = .GetExtensionName(xPath)

        Do While .FileExists(xPath)
            i = i + 1
            xPath = .BuildPath(strFolder, strBaseName & " - " & i & "." & strExt)
        Loop
    End With

    GetNextAvailableFilename = xPath
End Function

标签： vbapdf

解决方案

你没有回答我的澄清问题...

只是为了测试，请尝试下一个适配的功能：

Private Sub WorksheetsToPDF(wb As Workbook, DistinationPath As String, ParamArray arr() As Variant)
    Dim El
    wb.Sheets(arr()).Select
    For Each El In arr()
       wb.Sheets(El).PageSetup.FitToPagesWide = 1
       wb.Sheets(El).PageSetup.PaperSize = xlPaperA4 ' xlPaperLetter
       wb.Sheets(El).PageSetup.Orientation = xlLandscape
    Next
    'Debug.Print EFDK.GetNextavailablefilename(DistinationPath)
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, FileName:=EFDK.GetNextavailablefilename(DistinationPath), Quality:=xlQualityStandard, IncludeDocProperties:=True
End Sub

推荐阅读