0

第一次来这里！我有一个使用多个工作表的电子表格，每个工作表的格式如下：

**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 名学生中的每一个创建一个活动表范围......

任何想法将不胜感激！

瓦托:)

4

1 回答 1

0

在评论中澄清后修改答案（进一步修改格式）：

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

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

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

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

希望这可以帮助。

于 2013-07-29T13:25:35.127 回答