excel - Excel - 每次打印后自动增加多个单元格
问题描述
我需要在每次打印后线性增加绿色单元格中的数字(见添加的图片)。例如,如果我将第一个表(绿色单元格,C2)中的起始编号设置为 1,则后面的单元格 K2、C21、K21 将打印为 2、3、4,之后它们将相应上升为 5、6、7 ,8 在下一个打印副本中,除非达到指定的打印副本数量。
这是我的工作表的例子
我试图为此查找宏,但发现只有一个以我想要的方式工作。
Sub PrintCopies_ActiveSheet()
Dim CopiesCount As Long
Dim copynumber As Long
CopiesCount = Application.InputBox("How many copies do you want?", Type:=1)
For copynumber = 1 To CopiesCount
With ActiveSheet
.Range("C2,K2,C21,K21").Value = copynumber
.PrintOut 'Print the sheet
End With
Next copynumber
End Sub
遗憾的是,它仅适用于 1 个单元格,所以当我打印此表时。所有聚焦的单元格都具有相同的编号(第一次打印 = 1,1,1,1;第二次打印 = 2,2,2,2,依此类推。
提前感谢各位大神,祝您有美好的一天。最好的问候,莫蒂
解决方案
所以我很幸运地找到了带有这个惊人宏的旧线程,并根据我的需要对其进行了调整。它的工作很神奇:D. 最后一个问题,是否可以使用单元格 C1 中的数字作为起始编号而不是 copynumber 来设置起始点?甚至可以选择设置任务栏询问起始编号。它是为我的同事准备的,所以我试图让它尽可能简单
宏:
Public Sub IncrementPrint()
Dim resp As Variant, scr As Boolean, i As Long, j As Long
On Error Resume Next
resp = Application.InputBox(Prompt:="Please enter the number of copies to print:", _
Title:="Select Total Print Copies", Type:=1)
On Error GoTo 0
If resp = False Then Exit Sub
If resp < 1 Or resp > 100 Then
MsgBox "Invalid number: " & resp & " (Enter 1 to 100)", vbExclamation, "Try Again"
Exit Sub
End If
scr = Application.ScreenUpdating
Application.ScreenUpdating = False
j = 0
For i = 1 To resp
ActiveSheet.Range("C2").Value2 = i + 0 + j
ActiveSheet.Range("K2").Value2 = i + 1 + j
ActiveSheet.Range("C21").Value2 = i + 2 + j
ActiveSheet.Range("K21").Value2 = i + 3 + j
ActiveSheet.PrintOut
j = j + 3
Next i
ActiveSheet.Range("C2,K2,C21,K21").ClearContents
Application.ScreenUpdating = scr
End Sub
编辑:嗯,我已经自己解决了,只是如果有人可以查看我的代码并确认其编写良好以避免将来可能出现的错误:D
Public Sub IncrementPrint()
Dim resp As Variant, scr As Boolean, i As Long, j As Long
On Error Resume Next
resp = Application.InputBox(Prompt:="Please enter the number of copies to print:", _
Title:="Select Total Print Copies", Type:=1)
On Error GoTo 0
If resp = False Then Exit Sub
If resp < 1 Or resp > 100 Then
MsgBox "Invalid number: " & resp & " (Enter 1 to 100)", vbExclamation, "Try Again"
Exit Sub
End If
On Error Resume Next
StartValue = Application.InputBox(Prompt:="Please enter start number:", _
Title:="Start number", Type:=1)
On Error GoTo 0
If StartValue = False Then Exit Sub
If StartValue < 1 Or resp > 10000 Then
MsgBox "Invalid number: " & StartValue & " (Enter 1 to 10000)", vbExclamation, "Try Again"
Exit Sub
End If
scr = Application.ScreenUpdating
Application.ScreenUpdating = False
j = 0
For i = 1 To resp
ActiveSheet.Range("C2").Value2 = i + 0 + j + StartValue - 1
ActiveSheet.Range("K2").Value2 = i + 1 + j + StartValue - 1
ActiveSheet.Range("C21").Value2 = i + 2 + j + StartValue - 1
ActiveSheet.Range("K21").Value2 = i + 3 + j + StartValue - 1
ActiveSheet.PrintOut
j = j + 3
Next i
ActiveSheet.Range("C2,K2,C21,K21").ClearContents
Application.ScreenUpdating = scr
End Sub
推荐阅读
- android - 如何在现有片段中获取捆绑包
- r - 导入具有几乎相似路径和名称的文件
- neo4j - Neo4j:是否可以创建仅包含数据子集的只读副本?
- java - 将webapp转换为war文件时覆盖现有源文件是什么意思
- c# - LINQ Lambda 改进
- c# - IPointerHandler 在某些情况下有效,但在其他情况下无效
- powershell - Check shared drive is already mapped
- windows - Jenkins 与 Windows ssh - PATH 不工作
- node.js - Node: Generate 6 digits random number using crypto.randomBytes
- javascript - How to remove `&` sign and all text after that from url