打印同一工作表的多份副本，但用另一工作表中的列表（范围）中的数据替换一个单元格

Question

我正在尝试打印几个月的时间表。 因此，打印 20 份同一工作表，并使用“支付周期”工作表上的每两周日期列表更改一个单元格（“时间表”工作表上的单元格“C1”）上的日期。

尝试了多种方法但由于各种原因无法接近...

有兴趣了解为什么我在下面尝试过的每种方法上都会出错或卡住。

Sub PrintAllDates()
    Dim printDate As Date
    Dim startDate As Date
    Dim endDate As Date

    startDate = Worksheets("Pay Periods").Range("A2")
    endDate = Worksheets("Pay Periods").Range("A10")
    
    For printDate = startDate To endDate
        Sheets("Timesheet").Range("C1") = printDate
        Sheets("Timesheet").PrintOut
Next

这有效，但我不知道如何让它使用列表。 它打印出连续 9 天，而我的列表是连续 9 天“两周”。

Sub PrintCopies()
    Dim i As Integer
    Dim VList As Variant
    
    VList = Sheets("Pay Periods").Range("H2:H3").Value
      
    For i = LBound(VList) To UBound(VList)
        Range("C1") = VList(i)
        ActiveSheet.PrintOut
    Next

有了上面的内容，我在Range("C1") = VList(i)上得到运行时错误 9“下标超出范围”

Sub PrintCopies()
    Dim i As Date
    Dim VList As Variant

    VList = Array(Worksheets("Pay Periods").Range("A2:A10"))
    For i = LBound(VList) To UBound(VList)
        Sheets("Timesheet").Range("C1") = VList(i)
        Sheets("Timesheet").PrintOut
    Next

这也有效，但只有 1 页被打印出来。 日期也被转换为“ 1900 年 1 月 13 日”。

Answer 1

您的代码可以是这样的：

Sub PrintAllDates()
Dim listRange As Range ' Your range A2:A10 in "Pay Periods" sheet '
Dim oCurrentCell As Range   ' Single cell from this range '
Dim printedSheet As Worksheet   ' Target sheet - "Timesheet" '
Dim oTargetCell As Range    ' C1 - target cell (to set next date from list) '

    Set listRange = Worksheets("Pay Periods").Range("A2:A10")
    Set printedSheet = Worksheets("Timesheet")
    Set oTargetCell = printedSheet.Range("C1")
    
    For Each oCurrentCell In listRange.Cells
        oTargetCell = oCurrentCell
Rem If some cells in "Timesheet" has formulas which reffered to C1,
Rem  we need recalc it before printing
        printedSheet.Calculate
        printedSheet.PrintOut
    Next oCurrentCell
End Sub

Answer 2

第一个代码不起作用，因为它没有考虑整个日期范围； 相反，它只需要第一个和最后一个单元格内的值，将它们视为日期。 该代码基本上采用这些日期并涵盖它们之间的每一天。 它甚至不知道 A2 和 A10 之间的其他单元格。 这个应该有效：

Sub PrintAllDates()
    
    'Declaring variables.
    Dim RngDate As Range
    Dim RngDates As Range
    Dim RngTarget As Range
    
    'Setting variables.
    Set RngDates = Sheets("Pay Periods").Range("A2:A10")
    Set RngTarget = Sheets("Timesheet").Range("C1")
    
    'Covering each cell in RngDates.
    For Each RngDate In RngDates
        
        'Changing RngTarget.
        RngTarget = RngDate.Value
        
        'Printing RngTarget's sheet.
        RngTarget.Parent.PrintOut
    
    Next
    
End Sub

我还添加了一个功能来检查给定值是否是此版本中的日期：

Sub PrintAllDates()
    
    'Declaring variables.
    Dim RngDate As Range
    Dim RngDates As Range
    Dim RngTarget As Range
    
    'Setting variables.
    Set RngDates = Sheets("Pay Periods").Range("A2:A10")
    Set RngTarget = Sheets("Timesheet").Range("C1")
    
    'Covering each cell in RngDates.
    For Each RngDate In RngDates
        
        'Checking if RngDate does not contain a date value.
        If Not VBA.Information.IsDate(RngDate.Value) Then
            
            'Asking what to do in case RngDate does not contain a date value.
            Select Case MsgBox("Range " & RngDate.Address(False, False) & " in sheet " & RngDate.Parent.Name & " contains the value """ & RngDate.Value & """, which is a non-date value." & vbCrLf & _
                               vbCrLf & _
                               vbCrLf & _
                               "Do you wish to use it and print anyway?" & vbCrLf & _
                               vbCrLf & _
                               "Press ""Yes"" to print it anyway." & vbCrLf & _
                               vbCrLf & _
                               "Press ""No"" to not print it and proceed to the next value." & vbCrLf & _
                               vbCrLf & _
                               "Press ""Cancel"" to stop the macro and print no more.", _
                               vbYesNoCancel, _
                               "Non-date value detected" _
                              )
                'If "Cancel" is pressed, the macro is terminated.
                Case Is = 2
                    Exit Sub
                'If "Yes" is pressed, the macro goes on.
                Case Is = 6
                    
                'If "No" is pressed, the macro goes to NextRngDate
                Case Is = 7
                    GoTo NextRngDate
            End Select
        End If
        
        'Changing RngTarget.
        RngTarget = RngDate.Value
        
        'Printing RngTarget's sheet.
        RngTarget.Parent.PrintOut
                
'Checkpoint.
NextRngDate:
    
    Next
    
End Sub