[英]Excel VBA: Auto increment cell value after each printing
我在 EctendOffice 上找到了一個 VBA 代碼,用於在每次打印后遞增單元格中的數字。 現在我需要在每次打印后在同一頁上增加 4 個單元格值。 示例:當我將打印數量設置為 50 時,單元格 C27 的值應為 1/50,單元格 M27 = 2/50,單元格 C58 = 3/50,單元格 M58 = 4/50。 下一頁應該是 5/50、6/50、7/50、8/50 等。
這是我用來每頁只打印一個 label 並遞增一個單元格值的代碼:
Sub IncrementPrint()
'updateby Extendoffice
Dim xCount As Variant
Dim xScreen As Boolean
Dim I As Long
On Error Resume Next
LInput:
xCount = Application.InputBox("Please enter the number of copies you want to print:", "Kutools for Excel")
If TypeName(xCount) = "Boolean" Then Exit Sub
If (xCount = "") Or (Not IsNumeric(xCount)) Or (xCount < 1) Then
MsgBox "error entered, please enter again", vbInformation, "Kutools for Excel"
GoTo LInput
Else
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
For I = 1 To xCount
ActiveSheet.Range("C27").Value = I & " / " & xCount
ActiveSheet.PrintOut
Next
ActiveSheet.Range("C27").ClearContents
Application.ScreenUpdating = xScreen
End If
End Sub
Option Explicit
Sub PrintWithIncrement()
Const WORKSHEET_NAME As String = "Sheet1"
Const RANGE_ADDRESS As String = "C27,M27,C58,M58"
Const PROMPT As String = "Please enter the number of copies you want to print:"
Const TITLE As String = "Print With Increment"
Const DEFAULT_COPIES As Long = 1
Const MAX_COPIES As Long = 100
Const APPLY_TOTAL_LOGIC As Boolean = False
Dim pCount As Variant
Dim Msg As Long
Dim IsInputValid As Boolean
Do Until IsInputValid
pCount = Application.InputBox(PROMPT, TITLE, DEFAULT_COPIES, , , , , 1)
If VarType(pCount) = vbBoolean Then
MsgBox "Dialog canceled.", vbExclamation, TITLE
Exit Sub
End If
If Int(pCount) = pCount Then
If pCount > 0 Then IsInputValid = True
End If
If IsInputValid Then
If pCount > MAX_COPIES Then
Msg = MsgBox("This will print " & pCount & " copies." _
& vbLf & vbLf & "Are you sure?", _
vbQuestion + vbYesNo + vbDefaultButton2, TITLE)
If vbNo Then IsInputValid = False
End If
Else
MsgBox "lnvalid entry: " & pCount & vbLf & vbLf _
& "Try again.", vbExclamation, TITLE
End If
Loop
Application.ScreenUpdating = False
Dim wb As Workbook: Set wb = ThisWorkbook ' workbook containing this code
Dim ws As Worksheet: Set ws = wb.Sheets(WORKSHEET_NAME)
Dim rg As Range: Set rg = ws.Range(RANGE_ADDRESS)
rg.NumberFormat = "@"
Dim tCount As Long: tCount = pCount
If APPLY_TOTAL_LOGIC Then tCount = tCount * rg.Cells.Count
Dim cell As Range, p As Long, t As Long
For p = 1 To pCount
For Each cell In rg.Cells
t = t + 1
cell.Value = t & "/" & tCount
Debug.Print cell.Value ' Test with this first! Uncomment later!
'ws.PrintOut ' Out-comment when done testing!
Next cell
Next p
rg.ClearContents
Application.ScreenUpdating = True
MsgBox "Print job finished.", vbInformation, TITLE
End Sub
我的 3 份邏輯 ( APPLY_TOTAL_LOGIC = TRUE
)
1/12
2/12
3/12
4/12
5/12
6/12
7/12
8/12
9/12
10/12
11/12
12/12
3 份副本的邏輯 ( APPLY_TOTAL_LOGIC = FALSE
)
1/3
2/3
3/3
4/3
5/3
6/3
7/3
8/3
9/3
10/3
11/3
12/3
這很容易通過一個循環和一個變量為您想要打印的 4 個單元格中的每一個來完成。 每次迭代后,變量值都會增加 4。
例如聲明你的變量
dim cell_m27 as integer
在循環之前將值設置為 1
cell_m27 = 1
在你的循環中,你每次增加一個:
cell_m27 = cell_m27 + 4
並復制其他三個變量,但從 2、3 和 4 開始。然后它們將在每個循環中增加 4,直到達到 xCount 並完成循環。
Sub IncrementPrint()
Dim xCount As Variant, xScreen As Boolean, i As Long
Dim rng As Range, bOK As Boolean, msg as string
msg = "Please enter the number of copies you want to print:"
Set rng = Range("C27,M27,C58,M58")
rng.ClearContents
rng.NumberFormat = "@"
LInput:
xCount = Application.InputBox(msg)
If TypeName(xCount) = "Boolean" Then Exit Sub
bOK = False
If IsNumeric(xCount) Then
bOK = xCount > 0
End If
If bOK Then
xScreen = Application.ScreenUpdating
Application.ScreenUpdating = False
i = 0
Do While i <= xCount
For Each c In rng.Cells
i = i + 1
If i <= xCount Then
c.Value = i & "/" & xCount
End If
Next
ActiveSheet.PrintOut
rng.ClearContents
Loop
Application.ScreenUpdating = xScreen
Else
MsgBox xCount & " not numeric,please enter again", vbInformation
GoTo LInput
End If
End Sub
聲明:本站的技術帖子網頁,遵循CC BY-SA 4.0協議,如果您需要轉載,請注明本站網址或者原文地址。任何問題請咨詢:yoyou2525@163.com.