Excel VBA需求：打印后自动递增同一页面内4个单元格数值

原代码仅支持打印时单个单元格数值递增，现需调整为每次打印一页时，同一页面的C27、M27、C58、M58四个单元格按顺序填充递增的数值，规则如下：

• 若设置打印份数为N，第一页四个单元格依次为 1/(N*4)、2/(N*4)、3/(N*4)、4/(N*4)
• 第二页则为 5/(N*4)、6/(N*4)、7/(N*4)、8/(N*4)
• 以此类推，直到完成所有打印页面的输出

修改后的VBA代码如下：

Sub IncrementPrint_MultiCells()
    Dim xTotalCopies As Variant
    Dim xScreenUpdating As Boolean
    Dim iPage As Long
    Dim currentNum As Long
    
    On Error Resume Next
LInput:
    xTotalCopies = Application.InputBox("请输入需要打印的总页数：", "批量打印设置")
    ' 用户取消输入则退出程序
    If TypeName(xTotalCopies) = "Boolean" Then Exit Sub
    ' 校验输入的合法性
    If (xTotalCopies = "") Or (Not IsNumeric(xTotalCopies)) Or (xTotalCopies < 1) Then
        MsgBox "输入无效，请重新输入正整数", vbInformation, "提示"
        GoTo LInput
    Else
        xScreenUpdating = Application.ScreenUpdating
        Application.ScreenUpdating = False
        
        ' 按页面循环，每页填充4个连续递增的数值
        For iPage = 1 To xTotalCopies
            currentNum = (iPage - 1) * 4 + 1
            ' 依次为四个目标单元格赋值
            ActiveSheet.Range("C27").Value = currentNum & " / " & xTotalCopies * 4
            ActiveSheet.Range("M27").Value = currentNum + 1 & " / " & xTotalCopies * 4
            ActiveSheet.Range("C58").Value = currentNum + 2 & " / " & xTotalCopies * 4
            ActiveSheet.Range("M58").Value = currentNum + 3 & " / " & xTotalCopies * 4
            ' 打印当前页面
            ActiveSheet.PrintOut
        Next iPage
        
        ' 打印完成后批量清空四个单元格
        ActiveSheet.Range("C27,M27,C58,M58").ClearContents
        Application.ScreenUpdating = xScreenUpdating
    End If
End Sub

关键修改说明 #

• 新增currentNum变量，通过(iPage - 1) * 4 + 1计算每页的起始序号，保证每页四个单元格的数值连续递增
• 总序号范围调整为xTotalCopies * 4，对应所有页面的总序号数量
• 批量设置四个目标单元格的数值，替代原有的单个单元格赋值逻辑
• 打印完成后批量清空目标单元格，提升操作效率

内容的提问来源于stack exchange，提问作者Ismet