Hỗ trợ Code VBA tự động in tem để dán lên các thùng hàng (2 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
Tôi tuân thủ nội quy khi đăng bài
Có
T

TrungKien34

Thành viên mới
Tham gia
6/6/23
Bài viết
9
Được thích
1
Xin chào toàn bộ các anh chị em trên diễn đàn !

Mình có 1 file dùng để in tem dán lên các thùng hàng khi xuất hàng cho khách hàng, hiện tại đang phải làm thủ công mất nhiều thời gian.
Nhờ các anh chị em trên diễn đàn hỗ trợ giúp mình code VBA để thao tác in được nhanh hơn. Như mong muốn của mình ở trong file đính kèm
Sheet: Shipping_data: Nhập dữ liệu để in tem cần dán lên thùng
Sheet: form_print: là sheet form tem dán, mỗi lần in được 3 tem trên khổ A4
Sheet Master_Data: dữ liệu hàng hóa.
Có thể in 1 lần hết tất cả các dòng hoặc in từng dòng trong sheet Shipping_Data.
Rất mong anh chị em trong diễn đàn giúp đỡ.

Trân trọng cảm ơn anh chị em!
 

File đính kèm

Lần chỉnh sửa cuối:
Sắp xếp theo thời gian sắp xếp theo bầu chọn
TrungKien34 đã viết:
Xin chào toàn bộ các anh chị em trên diễn đàn !

Mình có 1 file dùng để in tem dán lên các thùng hàng khi xuất hàng cho khách hàng, hiện tại đang phải làm thủ công mất nhiều thời gian.
Nhờ các anh chị em trên diễn đàn hỗ trợ giúp mình code VBA để thao tác in được nhanh hơn. Như mong muốn của mình ở trong file đính kèm
Sheet: Shipping_data: Nhập dữ liệu để in tem cần dán lên thùng
Sheet: form_print: là sheet form tem dán, mỗi lần in được 3 tem trên khổ A4
Sheet Master_Data: dữ liệu hàng hóa.
Có thể in 1 lần hết tất cả các dòng hoặc in từng dòng trong sheet Shipping_Data.
Rất mong anh chị em trong diễn đàn giúp đỡ.

CảTrân trọng cảm ơn anh chị em!
Nhấp chuột vào đây để mở rộng...
Thử code này kiểm tra trước khi chạy không lại tốn giấy.
Mã: 
Sub indulieu()
   Dim i As Long, lr As Long, b As Long, j As Long, arr, c As Long
   With Sheets("Shipping_Data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B4:J" & lr).Value
   End With
   With Sheets("form_print")
         For i = 1 To UBound(arr)
             b = 0
             For j = 1 To arr(i, 8) Step 3
                 b = arr(i, 7) * j
                 If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                 .Range("i3").Value = arr(i, 5)
                 .Range("i5").Value = arr(i, 6)
                 .Range("i12").Value = arr(i, 1)
                 .Range("i7").Value = c
                 .Range("Ac7").Value = j
                 .Range("Aj8").Value = arr(i, 8)
                 .Range("Ac10").Value = arr(i, 3)
                 j = j + 1
                 If j > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac27").Value = Empty
                 Else
                   b = arr(i, 7) * j
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i20").Value = arr(i, 5)
                   .Range("i22").Value = arr(i, 6)
                   .Range("i29").Value = arr(i, 1)
                   .Range("i24").Value = c
                   .Range("Ac24").Value = j
                   .Range("Aj25").Value = arr(i, 8)
                   .Range("Ac27").Value = arr(i, 3)
                 End If
                 j = j + 1
                 If j > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac44").Value = Empty
                 Else
                   b = arr(i, 7) * j
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i37").Value = arr(i, 5)
                   .Range("i39").Value = arr(i, 6)
                   .Range("i46").Value = arr(i, 1)
                   .Range("i41").Value = c
                   .Range("Ac41").Value = j
                   .Range("Aj42").Value = arr(i, 8)
                   .Range("Ac44").Value = arr(i, 3)
                 End If
            ' .PrintOut
             .PrintPreview
             Next j
        Next i
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Thử code này kiểm tra trước khi chạy không lại tốn giấy.
Mã: 
Sub indulieu()
   Dim i As Long, lr As Long, b As Long, j As Long, arr, c As Long
   With Sheets("Shipping_Data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B4:J" & lr).Value
   End With
   With Sheets("form_print")
         For i = 1 To UBound(arr)
             b = 0
             For j = 1 To arr(i, 8) Step 3
                 b = arr(i, 7) * j
                 If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                 .Range("i3").Value = arr(i, 5)
                 .Range("i5").Value = arr(i, 6)
                 .Range("i12").Value = arr(i, 1)
                 .Range("i7").Value = c
                 .Range("Ac7").Value = j
                 .Range("Aj8").Value = arr(i, 8)
                 .Range("Ac10").Value = arr(i, 3)
                 j = j + 1
                 If j > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac27").Value = Empty
                 Else
                   b = arr(i, 7) * j
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i20").Value = arr(i, 5)
                   .Range("i22").Value = arr(i, 6)
                   .Range("i29").Value = arr(i, 1)
                   .Range("i24").Value = c
                   .Range("Ac24").Value = j
                   .Range("Aj25").Value = arr(i, 8)
                   .Range("Ac27").Value = arr(i, 3)
                 End If
                 j = j + 1
                 If j > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac44").Value = Empty
                 Else
                   b = arr(i, 7) * j
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i37").Value = arr(i, 5)
                   .Range("i39").Value = arr(i, 6)
                   .Range("i46").Value = arr(i, 1)
                   .Range("i41").Value = c
                   .Range("Ac41").Value = j
                   .Range("Aj42").Value = arr(i, 8)
                   .Range("Ac44").Value = arr(i, 3)
                 End If
            ' .PrintOut
             .PrintPreview
             Next j
        Next i
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Cảm ơn bạn, mình đã test code bạn gửi, tuy nhiên gặp 1 số vấn đề sau:
1. Các số tem có thứ tự 4,5,9,10,14,15,19,20,24,25,29,30,34,35,39,40 ( theo qui luật in 3 bỏ 2) bị bỏ qua không in được.
2. Ngày, tháng, năm xuất hàng chưa được thể hiện vào tem.
3. Mỗi trang in cần phải bấm 1 lần -> có thể hỗ trợ bấm 1 lần sẽ in hết số lượng tem của 1 dong trong sheet Shipping_Data.

Nhờ bạn và mọi người hỗ trợ xử lý giúp.
 
Upvote 0
TrungKien34 đã viết:
Cảm ơn bạn, mình đã test code bạn gửi, tuy nhiên gặp 1 số vấn đề sau:
1. Các số tem có thứ tự 4,5,9,10,14,15,19,20,24,25,29,30,34,35,39,40 ( theo qui luật in 3 bỏ 2) bị bỏ qua không in được.
2. Ngày, tháng, năm xuất hàng chưa được thể hiện vào tem.
3. Mỗi trang in cần phải bấm 1 lần -> có thể hỗ trợ bấm 1 lần sẽ in hết số lượng tem của 1 dong trong sheet Shipping_Data.

Nhờ bạn và mọi người hỗ trợ xử lý giúp.
Nhấp chuột vào đây để mở rộng...
Cái số 3 là họ để bạn test trước khi in mà.Muốn in liền thì bỏ cái dấu ' trước
Mã: 
  ' .PrintOut
và xóa dòng
Mã: 
.PrintPreview
đi là được à
 
Upvote 0
TrungKien34 đã viết:
Cảm ơn bạn, mình đã test code bạn gửi, tuy nhiên gặp 1 số vấn đề sau:
1. Các số tem có thứ tự 4,5,9,10,14,15,19,20,24,25,29,30,34,35,39,40 ( theo qui luật in 3 bỏ 2) bị bỏ qua không in được.
2. Ngày, tháng, năm xuất hàng chưa được thể hiện vào tem.
3. Mỗi trang in cần phải bấm 1 lần -> có thể hỗ trợ bấm 1 lần sẽ in hết số lượng tem của 1 dong trong sheet Shipping_Data.

Nhờ bạn và mọi người hỗ trợ xử lý giúp.
Nhấp chuột vào đây để mở rộng...
Thử cái này.
Mã: 
Sub indulieu()
   Dim i As Long, lr As Long, b As Long, j As Long, arr, c As Long, T, k As Long
   With Sheets("Shipping_Data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B4:J" & lr).Value
   End With
   With Sheets("form_print")
         For i = 1 To UBound(arr)
             b = 0
             T = Split(arr(i, 2), "/")
             For j = 1 To arr(i, 8) Step 3
                 b = arr(i, 7) * j
                 If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                 .Range("i3").Value = arr(i, 5)
                 .Range("i5").Value = arr(i, 6)
                 .Range("i12").Value = arr(i, 1)
                 .Range("i7").Value = c
                 .Range("Ac7").Value = j
                 .Range("Aj8").Value = arr(i, 8)
                 .Range("Ac10").Value = arr(i, 3)
                 .Range("i11") = T(0)
                 .Range("n11") = T(1)
                 .Range("s11") = T(2)
                 k = j + 1
                 If k > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac27").Value = Empty
                    .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 Else
                   b = arr(i, 7) * k
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i20").Value = arr(i, 5)
                   .Range("i22").Value = arr(i, 6)
                   .Range("i29").Value = arr(i, 1)
                   .Range("i24").Value = c
                   .Range("Ac24").Value = k
                   .Range("Aj25").Value = arr(i, 8)
                   .Range("Ac27").Value = arr(i, 3)
                 .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 End If
                 k = j + 2
                 If k > arr(i, 8) Then
                   .Range("i37").Value = Empty
                   .Range("i39").Value = Empty
                   .Range("i46").Value = Empty
                   .Range("i41").Value = Empty
                   .Range("Ac42").Value = Empty
                   .Range("Ac44").Value = Empty
                  .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 Else
                   b = arr(i, 7) * k
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i37").Value = arr(i, 5)
                   .Range("i39").Value = arr(i, 6)
                   .Range("i46").Value = arr(i, 1)
                   .Range("i41").Value = c
                   .Range("Ac41").Value = k
                   .Range("Aj42").Value = arr(i, 8)
                   .Range("Ac44").Value = arr(i, 3)
                   .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 End If
             .PrintOut
             'PrintPreview
             Next j
        Next i
  End With
End Sub
 
Upvote 0
snow25 đã viết:
Thử cái này.
Mã: 
Sub indulieu()
   Dim i As Long, lr As Long, b As Long, j As Long, arr, c As Long, T, k As Long
   With Sheets("Shipping_Data")
        lr = .Range("B" & Rows.Count).End(xlUp).Row
        arr = .Range("B4:J" & lr).Value
   End With
   With Sheets("form_print")
         For i = 1 To UBound(arr)
             b = 0
             T = Split(arr(i, 2), "/")
             For j = 1 To arr(i, 8) Step 3
                 b = arr(i, 7) * j
                 If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                 .Range("i3").Value = arr(i, 5)
                 .Range("i5").Value = arr(i, 6)
                 .Range("i12").Value = arr(i, 1)
                 .Range("i7").Value = c
                 .Range("Ac7").Value = j
                 .Range("Aj8").Value = arr(i, 8)
                 .Range("Ac10").Value = arr(i, 3)
                 .Range("i11") = T(0)
                 .Range("n11") = T(1)
                 .Range("s11") = T(2)
                 k = j + 1
                 If k > arr(i, 8) Then
                   .Range("i20").Value = Empty
                   .Range("i22").Value = Empty
                   .Range("i29").Value = Empty
                   .Range("i24").Value = Empty
                   .Range("Ac24").Value = Empty
                   .Range("Aj25").Value = Empty
                   .Range("Ac27").Value = Empty
                    .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 Else
                   b = arr(i, 7) * k
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i20").Value = arr(i, 5)
                   .Range("i22").Value = arr(i, 6)
                   .Range("i29").Value = arr(i, 1)
                   .Range("i24").Value = c
                   .Range("Ac24").Value = k
                   .Range("Aj25").Value = arr(i, 8)
                   .Range("Ac27").Value = arr(i, 3)
                 .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 End If
                 k = j + 2
                 If k > arr(i, 8) Then
                   .Range("i37").Value = Empty
                   .Range("i39").Value = Empty
                   .Range("i46").Value = Empty
                   .Range("i41").Value = Empty
                   .Range("Ac42").Value = Empty
                   .Range("Ac44").Value = Empty
                  .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 Else
                   b = arr(i, 7) * k
                   If b > arr(i, 4) Then c = arr(i, 9) Else c = arr(i, 7)
                   .Range("i37").Value = arr(i, 5)
                   .Range("i39").Value = arr(i, 6)
                   .Range("i46").Value = arr(i, 1)
                   .Range("i41").Value = c
                   .Range("Ac41").Value = k
                   .Range("Aj42").Value = arr(i, 8)
                   .Range("Ac44").Value = arr(i, 3)
                   .Range("i28") = T(0)
                 .Range("n28") = T(1)
                 .Range("s28") = T(2)
                 End If
             .PrintOut
             'PrintPreview
             Next j
        Next i
  End With
End Sub
Nhấp chuột vào đây để mở rộng...
Rât cảm ơn Pro, mình đã test và chạy OK.
Trân trọng cảm ơn các anh chị em trong diễn đàn !
 
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

D
  • Question Question
Quản lý email outlook qua VBA cần giúp đỡ (3 người xem)
Trả lời
9
Đọc
122
nguyendang95
N
G
Xin Code xóa Module. (3 người xem)
Trả lời
0
Đọc
28
GCQ
G
K
Xin dax tính tỷ trọng doanh thu (2 người xem)
Trả lời
18
Đọc
748
SteveNguyen1991
S
F
  • Question Question
Tự động Merge Mail bằng VBA
Trả lời
6
Đọc
180
Hoàng Tuấn 868
H
N
Một ví dụ về XLL add-in: Tương tác với Google Gemini dưới dạng công thức bảng tính (2 người xem)
    • Thích
Trả lời
0
Đọc
75
nguyendang95
N
H
Nhờ anh/chị giúp đỡ em viết công thức trừ dữ liệu theo FiFo
Trả lời
1
Đọc
94
HieuCD
H
BNTT
LockXLS - Chương trình bảo vệ an toàn cho các file bảng tính Excel (1 người xem)
    • Thích
4 5 6
Trả lời
118
Đọc
73K
YêuCN
Y
vsitcnh
Hỗ trợ công thức tính điểm dựa theo điều kiện.
Trả lời
14
Đọc
191
thuytrangbp28
T
K
  • Question Question
nhờ ace giúp đỡ tự động filter và In hàng loạt từng mục trong piviot table (1 người xem)
Trả lời
0
Đọc
70
khkkh
K
micam111
  • Question Question
Cách chạy nhiều đồng hồ đếm giờ trong VBA
Trả lời
4
Đọc
690
thuytrangbp28
T
B
Xin giải pháp chống sửa, xóa dữ liệu đã nhập vào từ ngày hôm trước. (1 người xem)
    • Thích
2
Trả lời
26
Đọc
7K
Tuấn Bụng Bự
Tuấn Bụng Bự
Emyeuexcel
  • Question Question
In tất cả các file trong cùng 1 thư mục
Trả lời
3
Đọc
205
Hoàng Tuấn 868
H
L
Lỗi font khi convert từ pdf
Trả lời
2
Đọc
101
DeTong
D
1
Hỏi về đánh dấu hàng ngang hàng dọc bằng màu khi kích chuột vào 1 ô
Trả lời
7
Đọc
198
Gà Công Nghệ
Gà Công Nghệ
PhanTuHuong
Sách Lập trình VBA trong AutoCAD đã có mặt (1 người xem)
    • Thích
    • Yêu thích
2
Trả lời
20
Đọc
1K
Mr.hieudoanxd
Mr.hieudoanxd
P
Excell code vba : Tìm Cell để sửa dữ liệu
    • Buồn
2
Trả lời
26
Đọc
577
Phạm Trường 80
P
D
Nhờ anh em giúp đỡ.
    • Buồn
Trả lời
2
Đọc
92
SA_DQ
SA_DQ
00029591
Cần hỗ trợ công thức tổng hợp dữ liệu không cần cột phụ Vlookup
Trả lời
2
Đọc
101
DeTong
D
H
Đổi số thành chữ trong office 365
Trả lời
19
Đọc
1K
HoangTan891026
H
Gà Công Nghệ
Lấy dữ liệu file excel từ sheet này sang sheet khác
Trả lời
4
Đọc
142
Gà Công Nghệ
Gà Công Nghệ
Xem thêm…

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALK SHOW: CÙNG NHẢY LAM BA ĐA VỚI HÀM LAMBDA (λ) EXCEL 365
Back
Top Bottom