Hỗ trợ Code VBA tự động in tem để dán lên các thùng hàng

Liên hệ QC
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

  • In phieu dan thung_hang xuat2.xlsm
    52.6 KB · Đọc: 37
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

B
  • Question
Chuyển dữ liệu từ cột sang dòng bằng vba excel
Trả lời
2
Đọc
36
VetMini
V
V
Tiếng Tây
Trả lời
2
Đọc
36
VetMini
V
NguyenTai1003
  • Question
Code lọc nội lực VBA
Trả lời
14
Đọc
3K
PhanTuHuong
PhanTuHuong
T
HỎI CÁCH LỌC DỮ LIỆU HIỆU QUẢ ĐẦY ĐỦ
Trả lời
4
Đọc
170
VetMini
V
N
  • Question
Com Add-Ins trong VBA
Trả lời
1
Đọc
134
Nguyễn Duy Tuân
Nguyễn Duy Tuân
vuha
Xử lý lỗi ứng dụng zalo PC dừng đột ngột (mã lỗi 0x42208) như thế nào?
Trả lời
9
Đọc
208
PhanTuHuong
PhanTuHuong
hoamattroicoi
Trích xuất file *.xml sang Excel cho hóa đơn điện tử áp dụng nghị định 123/2020
    • Thích
    • Yêu thích
    • Cảm ơn
4 5 6
Trả lời
106
Đọc
26K
dinhduy
D
T
Công thức tính tổng số lượng giữa hai Sheel nhiều điều kiện
Trả lời
5
Đọc
129
VetMini
V
thonglongtong
Thắc mắc về khác biệt các hàm cơ sở dữ liệu
Trả lời
1
Đọc
52
VetMini
V
T
Lấy dữ liệu giá cổ phiếu từ website bằng Python hay code VBA
2
Trả lời
35
Đọc
1K
Kiều Mạnh
Kiều Mạnh
P
  • Question
Tự động tạo folder và xuất pdf theo tên ngày hiện tại
Trả lời
13
Đọc
313
phan van tai
P
GPE-Trợ Lý
HN - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 29/09/2024
    • Thích
    • Ngạc nhiên
Trả lời
3
Đọc
145
PhanTuHuong
PhanTuHuong
LuuGiaPhúc
Code để lọc theo nhiều điều kiện
2
Trả lời
34
Đọc
821
cantl
C
N
Xin hỏi cách chia thời gian bằng Droplist
Trả lời
0
Đọc
40
namtn2562
N
Huế Vũ 1989
Cách chuyển công thức VBA từ 32 bit sang 64 bit ?
Trả lời
4
Đọc
599
Vinhwru1
Vinhwru1
T
  • Question
tự động chèn dòng trong vba
Trả lời
10
Đọc
152
VetMini
V
T
Chỉ tìm và cập nhật ô có chứa giá trị
Trả lời
3
Đọc
72
Tri1983
T
GPE-Trợ Lý
TP.HCM - Đăng ký tham dự sinh nhật GIAIPHAPEXCEL lần thứ 18 ngày 06/10/2024
    • Thích
Trả lời
3
Đọc
224
tungnguyen_kt
tungnguyen_kt
Q
Nhập dữ liệu nhanh
    • Cười
Trả lời
9
Đọc
222
VetMini
V
Q
lấy tháng trong chuỗi ký tự .
Trả lời
3
Đọc
57
quocnb
Q
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

Back
Top Bottom