Question

我拼凑了一个VBA脚本，它循环遍历数据列表，在摘要页面上更改单个单元格的值。那个细胞驱动了许多公式。每次迭代后，感兴趣的单元格范围将以PDF格式保存。

我希望每次在每个循环上生成“另存为”对话框时都不必手动输入。一旦我部署了这个脚本，我就可以看到1k +迭代了。

Sub AlterID()

Dim ws As Worksheet
Dim strPath As String
Dim myFile As Variant
Dim strFile As String

Set ws = Worksheets("Summary Data")

For Each c In Worksheets("Data").Range("A2:A11").Cells   
    Worksheets("Summary Data").Range("B1").Value = c.Value  

    strFile = ws.Range("D3").Value  
    strFile = ThisWorkbook.Path & "\" & strFile

    myFile = Application.GetSaveAsFilename _
    (InitialFileName:=strFile, _
        FileFilter:="PDF Files (*.pdf), *.pdf", _
        Title:="Select Folder and FileName to save")

    If myFile <> "False" Then
        ws.Range("D3:H9").Select  
        Selection.ExportAsFixedFormat _
            Type:=xlTypePDF, _
            Filename:=myFile, _
            Quality:=xlQualityStandard, _
            IncludeDocProperties:=True, _
            IgnorePrintAreas:=False, _
            OpenAfterPublish:=False
    End If

    Next

End Sub

Answer 1

Sub AlterID()

    Dim ws As Worksheet, c As Range
    Dim strFile As String

    Set ws = Worksheets("Summary Data")

    For Each c In Worksheets("Data").Range("A2:A11").Cells

        ws.Range("B1").Value = c.Value  

        strFile = ThisWorkbook.Path & "\" & ws.Range("D3").Value

        ws.Range("D3:H9").ExportAsFixedFormat _
                         Type:=xlTypePDF, _
                         Filename:=strFile, _
                         Quality:=xlQualityStandard, _
                         IncludeDocProperties:=True, _
                         IgnorePrintAreas:=False, _
                         OpenAfterPublish:=False
    Next

End Sub

Answer 2

您是否尝试过关闭应用程序警报？

Application.DisplayAlerts = False 'before your code
Application.DisplayAlerts = True  'after your code

编辑1

这是我用来将文件保存为PDF的子

Sub SaveAsPDF()
Dim myValue As Variant
Dim mySheets As Variant

mySheets = Array("Report")
For Each sh In mySheets
    Sheets(sh).PageSetup.Orientation = xlLandscape
Next

uid = InputBox("Enter your UID")
uid = StrConv(uid, vbProperCase)

Application.PrintCommunication = False
    With Sheets("Report").PageSetup
        .FitToPagesWide = 1
        .FitToPagesTall = False
    End With
    Application.PrintCommunication = True

Dim fName As String
fName = "HMB SOX report for week ending " & ActiveSheet.Range("H4").Text
Call selectPage("Report")
With ActiveSheet
        .ExportAsFixedFormat Type:=xlTypePDF, fileName:= _
          "C:\Users\" & uid & "\Desktop\" & fName, :=xlQualityStandard, _
         IncludeDocProperties:=True, IgnorePrintAreas:=False, Publish:=False
End With

End Sub

避免在Excel VBA脚本中“另存为”对话框

2 个答案: