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

...它做了我想要的，但是（a）pdf每页有一张纸，这意味着很多空白，（b）它不适合一页，所以格式化出错，（c）如果可能的话，我希望它更加自动化，这样我就不必为150名学生中的每一个创建一个活动表格范围......

任何想法都将不胜感激！

Watto：）

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环境变量。

上面这个修改过的脚本添加了一个新的临时表，从第二张表中取出头（因为temp现在是第一张）然后遍历第二张表上的所有行（假设其他表具有相同的行数）因为每个学生每排一排）。在此内部有一个内部循环通过工作表来获取与当前学生相对应的行并将其复制到tmp工作表。然后将Tmp工作表导出为PDF并为下一个学生准备好。

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

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

希望这有帮助。

Excel - 将多个工作表中的单元格范围保存为pdf，没有空格

1 个答案: