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的列寬，您可以根據需要調整列字母。

希望這會有所幫助。