Form tạo Nhán dán lên thùng carton hàng hóa

Chia sẻ bởi:hands

★★★★★

‹ Tìm, liệt kê các số còn thiếu... Xin chỉ giùm về hàm rank có... ›

Quảng cáo

Em chào anh/chị!
Em đã mày mò và cóp nhặt code để tạo những Nhãn dán lên thùng hàng hóa (như trong Sheet Sh2) trong file đính kèm ạ, Tuy nhiên code chạy rất chậm nếu Mỗi cửa hàng có 5 kiện (mỗi kiện cần 2 Nhãn dán) x 38 Cửa hàng (số lượng cửa hàng là không cố định).
Mong anh/chị giúp đỡ em cập nhật code cho nhanh hơn ạ.
Em cảm ơn!

Viết code 1 mẫu in từng tờ 1 đừng viết điền toàn bộ rồi in thế kia.

Nhưng nếu in từng tờ thì em không thể dùng máy in để in đầy hết sang tờ giấy A4 ạ, hay a/c có thể gợi ý thêm cho em được không ạ?

Code để trong module 2. Nhấn button "Tạo booking form" để chạy.
Sheet "Temp", bạn chỉ để 1 mẫu thôi nhé. Cân chỉnh hàng, cột, chữ cho chuẩn cho 6 hàng và 2 cột.
Mẫu này sẽ được nhân lên tại sheet "nhandan"
Mình làm cho bạn phần tạo sheet "nhandan".
Phần format trang in bạn tự làm nhé.
Option Explicit
Sub nhandan()
Dim lr&, i&, j&, k&, stt&, sodong&, rng, nhan, kien&
Application.ScreenUpdating = False
With Sheets("Bang tong hop so kien")
lr = .Cells(Rows.Count, "C").End(xlUp).Row
rng = .Range("C2:F" & lr).Value
kien = WorksheetFunction.Sum(.Range("F2:F" & lr))
End With

'Tao sheet nhandan
If Evaluate("=ISREF(Nhandan!A1)") Then Sheets("Nhandan").Delete
Sheets("Temp").Copy after:=Sheets(Sheets.Count)
With ActiveSheet
.Name = "Nhandan"
For i = 1 To kien * 2 ' 2= so ban copy cua 1 kien
.Rows("1:6").Copy
.Rows(i * 6 + 1).PasteSpecial Paste:=xlPasteAllUsingSourceTheme
Next
.Rows("1:6").Delete
Application.CutCopyMode = False
lr = Cells(Rows.Count, "A").End(xlUp).Row + 1
nhan = Range("A1:B" & lr).Value
For i = 1 To UBound(rng)
sodong = rng(i, 4) * 6 * 2 ' 6= so dong cua template
For j = 1 To sodong
k = k + 1
stt = (k – 1) Mod 6 + 1
Select Case stt
Case 3
nhan(k, 1) = nhan(k, 1) & " " & rng(i, 1): nhan(k, 2) = rng(i, 4)
Case 4
nhan(k, 1) = rng(i, 2)
Case 5
nhan(k, 1) = nhan(k, 1) & " " & IIf(rng(i, 3) = "", Format(Date + 1, " – mm – yyyy"), Format(rng(i, 3), "dd/mm/yyyy"))
End Select
Next
Next
Range("A1:B" & lr).Value = nhan
End With
Application.ScreenUpdating = True
End Sub