Question

我有一个包含多个excel工作簿的文件夹，我需要将其导出为pdf。每个工作簿的每个工作表上都有一个徽标（.bmp）。当我使用下面的代码时，pdf都缺少徽标（它只有一个灰色的占位符）只在第一页上。其余页面都有徽标。

我的代码：

Option Explicit
Sub dsPdf()
Dim path        As String
Dim wbName      As String

Dim tWb         As Workbook
Dim t           As Single

path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")

Application.ScreenUpdating = True
Do While wbName <> ""
    Set tWb = Workbooks.Open(path & "\" & wbName)
    tWb.Sheets(Array(1, 2, 3)).Select
    DoEvents
    ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
        path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, _
        IgnorePrintAreas:=False, OpenAfterPublish:=False

    tWb.Close False
    wbName = Dir
Loop



End Sub

我尝试过使用ActiveSheet.RefreshAll和DoEvents，以及添加Timer / Do While循环。当我在导出语句之前放置Stop时，第一张表正确地显示了徽标。但是当我放Aplication.Wait(Now...时，徽标没有显示。

有什么想法吗？感谢

Answer 1

试试这个 - 我避免使用.Select，因为（我不确定），但我认为这可能会导致一些问题。

Sub dsPdf_NoSelect()
Dim path        As String
Dim wbName      As String

Dim tWb         As Workbook
Dim t           As Single
Dim i As Long

path = ThisWorkbook.path
wbName = Dir(path & "\*.xlsx")

Application.ScreenUpdating = True
Do While wbName <> ""
        Set tWb = Workbooks.Open(path & "\" & wbName)
    For i = 1 To 3
        tWb.Sheets(i).ExportAsFixedFormat Type:=xlTypePDF, Filename:=path & "\" & Left(wbName, Len(wbName) - 4) & "pdf", _
        Quality:=xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=False
    Next i
    tWb.Close False
    wbName = Dir
Loop

End Sub

Excel VBA-导出前不会加载第一张图片

1 个答案: