Option Explicit
Public SELrr, SEL%
Sub TEST()
Application.DisplayAlerts = False
'↑令程序執行不要問刪不刪(刪)
Application.ScreenUpdating = False
'↑令螢幕不隨程序執行結果做變化
Dim Brr, A, B, Z, i&, j%, xR As Range
'↑宣告變數
A = Array(1, 2, 5, 6, 11, 15, 16, 17, 19, 22, 27, 28, 31, 35, 40)
'↑令A變數是 一維陣列(索引號0~14,這是標籤版型的格號)
B = Array(2, 3, 4, 17, 5, 6, 7, 8, 9, 10, 11, 16, 12, 13, 14)
'↑令B變數是 一維陣列(索引號0~14,這是收料標籤的欄號)
If SEL = 1 Then Brr = SELrr Else: Brr = Range([收料標籤!Q2], [收料標籤!A65536].End(3))
'↑如果SEL變數是 1?,是就令Brr變數是SELrr變數(二維陣列),
'否則就令Brr變數是 二維陣列,以收料標籤表的A~Q欄儲存格值帶入陣列中
Set xR = [標籤版型!A1:E8]
'↑令xR變數是 [標籤版型!A1:E8](物件:儲存格)
On Error Resume Next: Sheets("合併列印").Delete: On Error GoTo 0
'↑令"合併列印"表 刪除
Sheets("標籤版型").Copy after:=Worksheets(Sheets.Count)
'↑令"標籤版型"表複製一份到 工作表索引最後
With Sheets(Sheets.Count)
.Name = "合併列印": .[A:E].Clear
'↑令複製的工作表改名為"合併列印",並清除A~E欄
With .DrawingObjects
If .Count > 0 Then .Delete
End With
'↑令刪除圖片.圖案....等
End With
For i = 1 To UBound(Brr)
If Brr(i, 5) = "" Then Exit For
For j = 0 To UBound(A): xR(A(j)) = Brr(i, B(j)): Next
xR(1) = xR(1) & "-": xR(16) = "倉:" & xR(16) & "/"
xR(17) = "儲:" & xR(17) & "/": xR(28) = "(" & xR(28) & ")"
xR(40) = xR(40) & Brr(i, 15)
xR.Copy Sheets("合併列印").Cells((i - 1) * 8 + 1, 1)
Next
'↑設順迴圈將 "收料標籤"表資料帶入 [標籤版型!A1:E8]後,
'複製到 "合併列印"表
SEL = 0
'↑令SEL變數為 0
Set xR = Nothing: Erase Brr, A, B
'↑令釋放變數
End Sub
Option Explicit
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target
Cancel = True
If Rows.Count = .EntireRow.Rows.Count Then Exit Sub
If .Row = 1 Then Exit Sub
Set SELrr = Intersect(.EntireRow, [A:Q])
If InStr(SELrr.Address, ",") Then Exit Sub
SEL = 1: Call TEST
End With
End Sub作者: max67424 時間: 2023-6-16 03:35
