首页 > 解决方案 > 导出excel到PDF文件-需要导出两次

问题描述

我正在使用 ExportAsFixedFormat 将 excel 文件导出为 PDF。我第一次导出时,文件没有完全写入(没有任何错误)。但是,当我运行 VBA 再次导出文件时,文件已完全导出。

以下是我第一次运行 VBA 时 pdf 中的数据示例。有没有人遇到过类似的事情?任何建议,将不胜感激!

在此处输入图像描述

这是我使用的代码

Sub CreatePDFBySCA()

Const sSlicerName As String = "area_nm" 'change the slicer name accordingly

Dim sDestFolder As String
Dim sI As SlicerItem

Dim rng As Range, cell1 As Range
Dim LibelleSca As String

LibelleSca = ActiveSheet.Cells(3, 21).Value

If LibelleSca = "XXXX" Then
    Set rng = Worksheets("PourMacro").Range("CO5:CO20")
ElseIf LibelleSca = "YYYY" Then
    Set rng = Worksheets("PourMacro").Range("E5:E5")
Else
    MsgBox "Erreur SCA"
    GoTo ExitTheSub
End If

With Application
    .EnableEvents = False
    .ScreenUpdating = False
End With

On Error GoTo ErrHandler

sDestFolder = ChoixDossier()

If Len(Dir(sDestFolder, vbDirectory)) = 0 Then
    MsgBox sDestFolder & " does not exist.", vbInformation
    GoTo ExitTheSub
End If

If Right(sDestFolder, 1) <> "\" Then
    sDestFolder = sDestFolder & "\"
End If

If Len(Dir(sDestFolder & LibelleSca, vbDirectory)) <> 0 Then
    MsgBox "Le dossier " & LibelleSca & " existe déjà."
    GoTo ExitTheSub
Else
    MkDir sDestFolder & LibelleSca
    MsgBox "Le dossier " & LibelleSca & " a été crée."
End If

sDestFolder = sDestFolder & LibelleSca & "\"

    
For Each cell1 In rng

    For Each sI In ActiveWorkbook.SlicerCaches("Slicer_" & sSlicerName).SlicerCacheLevels(1).SlicerItems
   
        If cell1.Value = Mid(sI.Name, 20, 4) Then
            Do While Not ExportAsPDF(sI.Name, sSlicerName, sDestFolder &  Mid(sI.Name, 20, 4) & Range("Y3") & ".pdf")
            Loop
        End If
    
    Next
Next

MsgBox "Completed...", vbInformation
    
ExitTheSub:
    With Application
        .EnableEvents = True
        .ScreenUpdating = True
    End With
    
    Exit Sub
    
ErrHandler:
    MsgBox "Error " & Err.Number & ":  " & Err.Description, vbCritical, "Error"
    Resume ExitTheSub
    
End Sub

ExportAsPDF 是使用以下代码创建的函数

Function ExportAsPDF(si_item As String, slicer_name As String, file_name As String) As Boolean
' Export US as PDF
ExportAsPDF = False
ActiveWorkbook.SlicerCaches("Slicer_" & slicer_name).VisibleSlicerItemsList = Array(si_item)
DoEvents
ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
    Filename:=file_name, _
    Quality:=xlQualityStandard, _
    IncludeDocProperties:=True, _
    IgnorePrintAreas:=False, _
    OpenAfterPublish:=False
DoEvents
ThisWorkbook.Sheets("Sheet1").Select
ExportAsPDF = True
End Function

标签: excelvbapdfexport-to-pdf

解决方案


推荐阅读