Question

点击button后，它将

复制CustomersSupport表格内的表格中特定单元格的值，
将其粘贴到StandardMDForm表格中的特定单元格，然后
打印出StandardMDForm表

这是我的代码：

Private Sub printMDs_Click()

Dim i As Long
Dim FolderPath As String

'Destination Directory to Save the PDF Files
FolderPath = GetDesktop() & "\MDs"

MkDir (FolderPath)

    'Loop through Rows from 5 to 84
    For i = 5 To 84

        'Check if Doctor Name is Available
        If Not IsEmpty(Worksheets("CustomersSupport").Cells(i, "I")) Then

        'Doctor Details
        Worksheets("StandardMDForm").Range("B4").Value = Worksheets("CustomersSupport").Cells(i, "I").Value
        Worksheets("StandardMDForm").Range("B5").Value = Worksheets("CustomersSupport").Cells(i, "G").Value
        Worksheets("StandardMDForm").Range("B6").Value = Worksheets("CustomersSupport").Cells(i, "H").Value
        Worksheets("StandardMDForm").Range("B7").Value = Worksheets("CustomersSupport").Cells(i, "E").Value
        Worksheets("StandardMDForm").Range("B9").Value = Worksheets("CustomersSupport").Cells(i, "J").Value
        Worksheets("StandardMDForm").Range("E5").Value = Worksheets("CustomersSupport").Cells(i, "C").Value
        Worksheets("StandardMDForm").Range("E6").Value = Worksheets("CustomersSupport").Cells(i, "F").Value
        Worksheets("StandardMDForm").Range("E7").Value = Worksheets("CustomersSupport").Cells(i, "D").Value
        Worksheets("StandardMDForm").Range("B10").Value = Worksheets("CustomersSupport").Cells(i, "K").Value

        'Brand 1
        Worksheets("StandardMDForm").Range("B14").Value = Worksheets("CustomersSupport").Cells(i, "L").Value
        Worksheets("StandardMDForm").Range("B15").Value = Worksheets("CustomersSupport").Cells(i, "M").Value
        Worksheets("StandardMDForm").Range("B18").Value = Worksheets("CustomersSupport").Cells(i, "N").Value

        'Brand 2
        Worksheets("StandardMDForm").Range("C14").Value = Worksheets("CustomersSupport").Cells(i, "O").Value
        Worksheets("StandardMDForm").Range("C15").Value = Worksheets("CustomersSupport").Cells(i, "P").Value
        Worksheets("StandardMDForm").Range("C18").Value = Worksheets("CustomersSupport").Cells(i, "Q").Value

        'Brand 3
        Worksheets("StandardMDForm").Range("D14").Value = Worksheets("CustomersSupport").Cells(i, "R").Value
        Worksheets("StandardMDForm").Range("D15").Value = Worksheets("CustomersSupport").Cells(i, "S").Value
        Worksheets("StandardMDForm").Range("D18").Value = Worksheets("CustomersSupport").Cells(i, "T").Value

        'Brand 4
        Worksheets("StandardMDForm").Range("E14").Value = Worksheets("CustomersSupport").Cells(i, "U").Value
        Worksheets("StandardMDForm").Range("E15").Value = Worksheets("CustomersSupport").Cells(i, "V").Value
        Worksheets("StandardMDForm").Range("E18").Value = Worksheets("CustomersSupport").Cells(i, "W").Value

        'Brand 5
        Worksheets("StandardMDForm").Range("F14").Value = Worksheets("CustomersSupport").Cells(i, "X").Value
        Worksheets("StandardMDForm").Range("F15").Value = Worksheets("CustomersSupport").Cells(i, "Y").Value
        Worksheets("StandardMDForm").Range("F18").Value = Worksheets("CustomersSupport").Cells(i, "Z").Value

        'Print MD Sheet
        Sheets("StandardMDForm").PrintOut

        End If

    Next

    'Focus back to the "CustomersSupport" Sheet
    Sheets("CustomersSupport").Select

    'Show Success SMS to the User
    MsgBox "MDs Successfully Saved as a .pdf File to 'MDs' Folder on your Desktop."

End Sub

'Check if Addin saving as a pdf is available
Private Function IsPDFLibraryInstalled() As Boolean
    IsPDFLibraryInstalled = _
        (Dir(Environ("commonprogramfiles") & _
        "\Microsoft Shared\OFFICE" & _
        Format(Val(Application.Version), "00") & _
        "\EXP_PDF.DLL") <> "")
End Function

'Create Directory folder if not exists
Function MkDir(directory As String)
    Set fso = CreateObject("Scripting.FileSystemObject")
    If Not fso.FolderExists(directory) Then
        fso.CreateFolder (directory)
    End If
End Function

'Get Desktop Directory
Function GetDesktop() As String
    Dim oWSHShell As Object
    Set oWSHShell = CreateObject("WScript.Shell")
    GetDesktop = oWSHShell.SpecialFolders("Desktop")
    Set oWSHShell = Nothing
End Function

我的问题是如何将其从每次打印StandardMDForm表单更改为

将所有结果StandardMDSheet附加到单个pdf文件中？

我在循环中尝试了此代码，但它将每个客户的StandardMDForm的每个副本保存在一个单独的文件中

Sheets("StandardMDForm").Select

ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, _
Filename:=FolderPath & "\" & doctorName, _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False

Answer 1

已编译但未经过测试....

Private Sub printMDs_Click()

    Dim i As Long
    Dim FolderPath As String
    Dim shtForm As Worksheet, shtSrc As Worksheet
    Dim wbNew As Workbook, numShts As Long, numForms As Long


    Set shtForm = ThisWorkbook.Worksheets("StandardMDForm")
    Set shtSrc = ThisWorkbook.Worksheets("CustomersSupport")

    Set wbNew = Workbooks.Add()
    numShts = wbNew.Sheets.Count

    'Destination Directory to Save the PDF Files
    FolderPath = GetDesktop() & "\MDs"

    MkDir (FolderPath)

    'Loop through Rows from 5 to 84
    For i = 5 To 84
        'Check if Doctor Name is Available
        If Not IsEmpty(shtSrc.Cells(i, "I")) Then
            With shtForm
                'Doctor Details
                .Range("B4").Value = shtSrc.Cells(i, "I").Value
                .Range("B5").Value = shtSrc.Cells(i, "G").Value
                .Range("B6").Value = shtSrc.Cells(i, "H").Value
                '...
                'etc
                '...
                .Copy after:=wbNew.Sheets(wbNew.Sheets.Count) '<<<<
                numForms = numForms + 1
            End With
        End If
    Next

    'anything to print to PDF?
    If numForms > 0 Then
        'remove the empy sheets
        Application.DisplayAlerts = False
        For i = 1 To numShts
            wbNew.Sheets(i).Delete
        Next i
        Application.DisplayAlerts = True

        'save the whole file to PDF
        wbNew.ExportAsFixedFormat Type:=xlTypePDF, _
        Filename:=FolderPath & "\Forms.pdf", Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, _
        OpenAfterPublish:=False

        wbNew.Close False 'close without saving

        'Show Success SMS to the User
        MsgBox "MDs Successfully Saved as a .pdf File to 'MDs' Folder on your Desktop."
    End If

End Sub

循环访问Excel工作表，复制并粘贴不同的值，并将所有生成的副本保存到同一个pdf文件中

1 个答案: