根据单元格值输出表格

Question

我正在尝试将不同的工作表集导出为指定的地图为pdf格式。 工作簿包含多个工作表，在工作表Printlist中，我有一个指定工作表，文件名和地图的列表。 （见图）

我想编写一个宏，将带有文件名的te sheetnames打印到指定的地图但是我当前的宏没有做到这一点 ] 1 代码：

Sub PDF_maken()

Dim ws As Worksheet
Dim LR As Long
Dim r As Range
Dim Mypath As String

Set ws = ActiveWorkbook.Worksheets("Printlijst")
LR = ws.Cells(Rows.Count, 1).End(xlUp).Row

For Each r In ws.Range("B2:B" & LR)

If Not IsEmty("B" & r) Then
Mypath = ws.Range("B" & r).Text
Sheets(Array(ws.Range("D" & r).Text, ws.Range("E" & r).Text, ws.Range("F" & r).Text, ws.Range("G" & r).Text)).Select
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Mypath & ws.Range("C" & r).Text & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, OpenAfterPublish:=False
End If

Next r

End Sub

Answer 1

过一会儿，但是如果有人遇到相同的问题，下面是修复它的代码：

Sub PDF_maken()

Dim ws As Worksheet
Dim LR As Long
Dim r As Range
Dim Mypath As String
Dim strarray As String
Dim Test As String
Dim strItem As String

Set ws = ActiveWorkbook.Worksheets("Printlijst")
LR = ws.Cells(Rows.Count, 4).End(xlUp).Row

For Each r In ws.Range("D3:D" & LR).Cells

strItem = ws.Range("E" & r.Row).Text
strItem = Replace(strItem, "~", "_")
strItem = Replace(strItem, Chr(34), "_")
strItem = Replace(strItem, "%", "_")
strItem = Replace(strItem, "#", "_")
strItem = Replace(strItem, "&", "_")
strItem = Replace(strItem, "*", "_")
strItem = Replace(strItem, ":", "_")
strItem = Replace(strItem, ",", "_")
strItem = Replace(strItem, "<", "_")
strItem = Replace(strItem, ">", "_")
strItem = Replace(strItem, "?", "_")
strItem = Replace(strItem, "{", "_")
strItem = Replace(strItem, "}", "_")
strItem = Replace(strItem, "|", "_")
strItem = Replace(strItem, "/", "_")

If Not IsEmpty("D" & r.Row) Then
Mypath = ws.Range("D" & r.Row).Text
strarray = ""
colCheck = 6
Do Until Cells(r.Row, colCheck) = ""
strarray = strarray & IIf(colCheck > 6, ",", "") & Cells(r.Row, colCheck).Value
colCheck = colCheck + 1
Loop


If InStr(1, strarray, ",") Then
Dim MyAr As Variant
    MyAr = Split(strarray, ",") '<~~ This is where we are creating an actual array


        ActiveWorkbook.Sheets(MyAr).Select
        ActiveWorkbook.Sheets(ws.Range("F" & r.Row).Text).Activate
    
   ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Mypath & strItem & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, OpenAfterPublish:=False


Else
  ActiveWorkbook.Sheets(strarray).ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
Mypath & strItem & ".pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _
 IgnorePrintAreas:=False, OpenAfterPublish:=False

End If
 End If
ws.Activate

Next r

   End Sub