遍历数据以填充表格并导出为单个PDF

时间:2018-08-28 20:20:49

标签: excel vba excel-vba

我最近对此发布了一个问题,但是我没有提供我想做的全部事情。谢谢那些第一次帮助我的人!

这就是我想要做的。

我正在尝试用另一个工作表中的数据填充表单。下面的代码运行。但是,当我查看放置文件的文件夹时,只会得到一个文件。我应该为For i = 2 To 5看到4个文件。

Form Data

注意事项: 来自列A的数据填充Range(“ B4:I4”)<---表单中的名称单元。 B列中的数据填充Range(“ B16:I16”)<---表单中的职务标题单元格。

Sub FormPop_Export_Click()
Dim i As Long
Dim Building_Location As String
Dim dataWS As Worksheet, formWS As Worksheet
Dim thisFile As Range, destRange As Range
Dim thisFile2 As Range, destRange2 As Range


FolderPath = "C:\Users\Lenovo\Documents\PAF_Output\"

MkDir FolderPath

Set dataWS = Sheets("Data")
Set formWS = Sheets("Form")
For i = 2 To 5
Set thisFile2 = dataWS.Range("A" & i)
Set destRange2 = formWS.Range("B4:I4")
thisFile2.Copy destRange2

Set thisFile = dataWS.Range("B" & i)
Set destRange = formWS.Range("B16:I16")
thisFile.Copy destRange


If WorksheetFunction.CountIf(formWS.Range("B16:I16"), "Coordinator") = 
destRange.Cells.Count Then
    Building_Location = "East Quad"
Else
    Building_Location = ""
End If
formWS.Range("D14:H14").Value = Building_Location


Sheets(Array("Form")).Select
ActiveSheet.ExportAsFixedFormat _
Type:=xlTypePDF, FileName:=FolderPath & thisFile & ".pdf", _
openafterpublish:=False, ignoreprintareas:=False

Next i

MsgBox "All PDF's have been exported to folder."


End Sub

我可以要求某人帮助吗?我正在扯头发!

1 个答案:

答案 0 :(得分:0)

也许您需要在循环中使用thisFile2

For i = 2 To 5
        Set thisFile2 = dataWS.Range("A" & i)

         Worksheets("PAF Form").ExportAsFixedFormat _
        Type:=xlTypePDF, Filename:=FolderPath & thisFile2.Value & ".pdf", _
        openafterpublish:=False, ignoreprintareas:=False

Next

由于formWS.Range("B16:I16")是合并的,所以Countif测试实际上应该是=1,或者正如@BigBen指出的那样,简单地If formWS.Range("B16") = "Coordinator" Then "East Quad"