Excel - 将多个单元格的范围保存为pdf，不含空白

Question

第一次在这里计时！我有它使用多个工作表电子表格，格式如下每张纸：

**Sheet 1** 

Name   Assessment Item 1 Assessment Item 2 
Student Name Feedback Item 1  Feedback Item 2 
Student Name Feedback Item 1  Feedback Item 2 

**Sheet 2** 

Name   Assessment Item 1 Assessment Item 2 
Student Name Feedback Item 1  Feedback Item 2 
Student Name Feedback Item 1  Feedback Item 2 

我希望能够给每个PDF导出标题行和一个学生行（所有工作表）。这意味着将标题行和8个学生行（每张一张）合并成一张表，然后导出，我在想。

我一直在使用这种代码：

Sub copyValueTable() 

ThisWorkbook.Sheets(Array("Sheet1", "Sheet2", "Sheet3")).Select 

ActiveSheet.Range("A1:F2").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
"C:\First.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ 
IgnorePrintAreas:=False, OpenAfterPublish:=True 

ActiveSheet.Range("A1:F1,A3:F3").ExportAsFixedFormat Type:=xlTypePDF, Filename:= _ 
"C:\Second.pdf", Quality:=xlQualityStandard, IncludeDocProperties:=True, _ 
IgnorePrintAreas:=False, OpenAfterPublish:=True 

End Sub 

...这我想要做什么，但（一）PDF有每页一张，这意味着很多空白的，（B ）它不适合一页，所以格式化会出错，并且（c）如果可能的话，我希望它更自动化，这样我就不必为每个150都创建一个活动表格范围学生...

任何想法将不胜感激！

沃图:)

Answer 1

以下的评论澄清修订答案（进一步修改格式化）：

Sub copyValueTable() 

    Dim ws As Worksheet 
    Dim heads 
    Dim new_sheet As Worksheet 
    Dim rownum 
    Dim ns_rownum 
    Dim filename 
    Dim filepath 
    Dim rowcnt 

    ' add a new workbook for the summary... 
    Set new_sheet = Sheets.add 
    rownum = 1 
    rowcnt = Sheets(2).Range("A1").End(xlDown).row 

    ' loop through rows in outer loop 
    For rownum = 2 To rowcnt 
     Debug.Print "..on student row " & rownum & " in outer loop..." 
     ns_rownum = 1 ' initialise for loop through sheets 

     ' loops through sheets (except new)... 
     For Each ws In Worksheets 
      If ws.Name <> new_sheet.Name Then 
       Debug.Print "....on sheet " & ws.Name & " in inner loop..." 

       ' copy heads... 
       ws.Rows(1).Copy new_sheet.Rows(ns_rownum) 
       ns_rownum = ns_rownum + 1 

       ' copy data for current record (paste to ns_rownum row to allow for other sheets) 
       ws.Rows(rownum).Copy 
       new_sheet.Rows(ns_rownum).PasteSpecial Paste:=xlPasteAll 

       ' paste column widths to new sheet on first pass through each sheet 
       If rownum = 2 Then 
        ws.Columns("A:Z").Copy 
        new_sheet.Columns("A:Z").PasteSpecial Paste:=xlPasteColumnWidths 
       End If 

       ns_rownum = ns_rownum + 2 
      End If 
     Next 

     ' write to pdf 
     filename = Sheets(2).Range("A" & rownum).Value 
     filepath = Environ("userprofile") & "\" & filename & ".pdf" 
     new_sheet.Rows("1:" & ns_rownum).ExportAsFixedFormat Type:=xlTypePDF, _ 
     filename:=filepath, Quality:=xlQualityStandard, IncludeDocProperties:=True, _ 
     IgnorePrintAreas:=False, OpenAfterPublish:=True 

     ' delete data in tmp sheet other than heads ready for next loop through sheets 
     Sheets(1).Rows("2:" & ns_rownum).Delete 

    Next rownum 

    ' clean up 
    Application.DisplayAlerts = False 
    new_sheet.Delete 
    Application.DisplayAlerts = True 
    Set new_sheet = Nothing 
    Set ws = Nothing 

End Sub 

你需要更换 'ENVIRON（ “USERPROFILE”）' 与路径你想用于pdf文件，这将为当前用户默认目录选择Windows环境变量。

上面这个修改后的脚本添加了一个新的临时表，从第二张表中取出头（因为现在临时是第一张）然后循环遍历第二张表上的所有行（假设其他表具有相同的no因为每个学生都有一行）。在这里面有一个内部循环，通过表单取对应于当前学生的行并将其复制到tmp表单中。 Tmp表格然后以PDF形式导出并清除，准备好给下一个学生。

请注意上面的假设，每个学生在每张表的同一行上。如果这是不正确的，那么将需要另一种机制来从适当的行中进行选择。

我已经复制列A：Z的列宽，您可以根据需要调整列字母。

希望这会有所帮助。