Question

我有一张包含多张纸的工作簿。

其中一张纸＆＃34; Calc＆＃34;根据在摘要页面上输入的员工ID号，总结了我在摘要页面上显示的8条火花线的数据。

我有一个创建的DO循环宏，可以按员工ID＃运行此摘要表，并转换为PDF并按ID号保存。

像魅力一样工作，节省数小时（字面意思）。麻烦是两个火花线不会更新。

我觉得Excel会快速允许他们更新。

我试图延迟Application.Wait(Now + TimeValue("00:00:01"))，并且已经过了两分钟......没有运气。有什么想法吗？

Option Explicit

Sub PDFtool()

    On Error GoTo errorHandle:

    Dim i As Integer
    i = 2

    Dim main, dataname, path, filename, ID As String

    path = Cells(5, 4)
    main = ActiveWorkbook.Name

    filename = ActiveWorkbook.path & "\" & "PDF files " & Format(Now(), "yyyy mm dd hh mm")
    MkDir filename

    Workbooks.Open filename:=path
    dataname = ActiveWorkbook.Name

    Do
        Worksheets("AM Location & ID#").Activate
        If Cells(i, 1) = "" Then Exit Do
        ID = Cells(i, 3)
        Worksheets("AM").Activate
        Cells(190, 1) = ID

        Worksheets("AM").Calculate

        ActiveSheet.ListObjects("Table33").Range.AutoFilter Field:=1, Criteria1:= _
        "TRUE"
        Columns("H:N").Select
        Selection.EntireColumn.Hidden = True

        ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _ 
            filename:=filename & "/" & ID & ".pdf", _ 
            Quality:=xlQualityStandard, IncludeDocProperties:=True, _  
            IgnorePrintAreas:=False, OpenAfterPublish:=False                                        

        Columns("G:S").Select
        Selection.EntireColumn.Hidden = False
        ActiveSheet.ListObjects("Table33").Range.AutoFilter Field:=1

        i = i + 1

    Loop

    Application.ScreenUpdating = True

    End


    errorHandle:
        Application.ScreenUpdating = True
        MsgBox ("ERROR! Call Greg")
        End

End Sub

火花线和DO循环

0 个答案: