按模板生成标签打印-Excel VBA程序开发-ExcelHome技术论坛

2025-11-10 23:02 关注

各位EH的坛友，大家好：
工作薄有四张表，第一表为需打印物料的物料记录，第二张表为打印标签的模板（正好为一张A4纸大小的模板），第三张表是根据第一张表生成的物料标签，打印格式按模板格式来打印。生成的标签中物料编码一栏为文本格式。附件详见如下。

生成标签打印1110.zip 2025-11-10 23:01 上传

22.93 KB, 下载次数: 25

赏

1692阅读

aman1516 Lv.7 2楼

2025-11-10 23:53

写入品号时，数据前面加个 “ ‘ ” 号

ykcbf1100 Lv.7 3楼

2025-11-11 06:51

第2张表和第3张表一样，整合成一个表也行吧。

绿色心情小天使楼主 4楼

2025-11-11 06:54

引用: ykcbf1100 发表于 2025-11-11 06:51
第2张表和第3张表一样，整合成一个表也行吧。

一个是按此模板格式打印，另一个是生成需要打印的一长条标签。

ykcbf1100 Lv.7 5楼

2025-11-11 07:19

引用: 绿色心情小天使发表于 2025-11-11 06:54
一个是按此模板格式打印，另一个是生成需要打印的一长条标签。

看上去二个表一样的。

ykcbf1100 Lv.7 6楼

2025-11-11 07:37

写了一个按模板生成打印表的代码，仅供参考。

代码仅适用于当前附件

生成标签打印1110.zip 2025-11-11 07:36 上传

33.63 KB, 下载次数: 50

ykcbf1100 Lv.7 7楼

2025-11-11 07:42

Sub ykcbf() '//2025.11.11
Application.ScreenUpdating = False
arr = Sheets("Date").UsedRange.Offset(1).Value
Sheets("模板").Cells.Copy Sheets("打印").[a1]
With Sheets("打印")
For i = 1 To UBound(arr) Step 3
m = m + 1
For j = 1 To 3
x = (m - 1) * 8 + 1
y = (j - 1) * 5 + 1
.Cells(x + 1, y + 1) = arr(i + j - 1, 1)
.Cells(x + 2, y + 1) = arr(i + j - 1, 2)
.Cells(x + 3, y + 1) = arr(i + j - 1, 3)
.Cells(x + 4, y + 1) = arr(i + j - 1, 4)
.Cells(x + 4, y + 2) = arr(i + j - 1, 5)
.Cells(x + 5, y + 1) = arr(i + j - 1, 6)
.Cells(x + 6, y + 1) = arr(i + j - 1, 7)
Next
Next
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

sungtinedue Lv.1 8楼

2025-11-11 16:10

删掉模板和打印两表的D列 Sub ykcbf() Application.ScreenUpdating = False arr = Sheets("Date").UsedRange.Offset(1).Value Sheets("模板").Cells.Copy Sheets("打印").[a1] With Sheets("打印") For i = 1 To UBound(arr) Step 3 m = m + 1 For j = 1 To 3 x = (m - 1) * 8 + 1 y = (j - 1) * 4 + 1 .Cells(x + 1, y + 1) = "'" & arr(i + j - 1, 1) .Cells(x + 2, y + 1) = arr(i + j - 1, 2) .Cells(x + 3, y + 1) = arr(i + j - 1, 3) .Cells(x + 4, y + 1) = arr(i + j - 1, 5) .Cells(x + 4, y + 2) = arr(i + j - 1, 4) .Cells(x + 5, y + 1) = arr(i + j - 1, 6) .Cells(x + 6, y + 1) = arr(i + j - 1, 7) Next Next End With Application.ScreenUpdating = True MsgBox "OK！" End Sub

sungtinedue Lv.1 9楼

2025-11-11 16:11

删掉  模板和打印2表中的D列
Sub ykcbf()
Application.ScreenUpdating = False
arr = Sheets("Date").UsedRange.Offset(1).Value
Sheets("模板").Cells.Copy Sheets("打印").[a1]
With Sheets("打印")
      For i = 1 To UBound(arr) Step 3
         m = m + 1
         For j = 1 To 3
            x = (m - 1) * 8 + 1
            y = (j - 1) * 4 + 1
            .Cells(x + 1, y + 1) = "'" & arr(i + j - 1, 1)
            .Cells(x + 2, y + 1) = arr(i + j - 1, 2)
            .Cells(x + 3, y + 1) = arr(i + j - 1, 3)
            .Cells(x + 4, y + 1) = arr(i + j - 1, 5)
            .Cells(x + 4, y + 2) = arr(i + j - 1, 4)
            .Cells(x + 5, y + 1) = arr(i + j - 1, 6)
            .Cells(x + 6, y + 1) = arr(i + j - 1, 7)
         Next
      Next
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub

sungtinedue Lv.1 10楼

2025-11-11 16:12

引用: ykcbf1100 发表于 2025-11-11 07:42

老师我在您的代码上做了一点改动，
我调试了一下，可以使用
Sub ykcbf()
Application.ScreenUpdating = False
arr = Sheets("Date").UsedRange.Offset(1).Value
Sheets("模板").Cells.Copy Sheets("打印").[a1]
With Sheets("打印")
      For i = 1 To UBound(arr) Step 3
         m = m + 1
         For j = 1 To 3
            x = (m - 1) * 8 + 1
            y = (j - 1) * 4 + 1
            .Cells(x + 1, y + 1) = "'" & arr(i + j - 1, 1)
            .Cells(x + 2, y + 1) = arr(i + j - 1, 2)
            .Cells(x + 3, y + 1) = arr(i + j - 1, 3)
            .Cells(x + 4, y + 1) = arr(i + j - 1, 5)
            .Cells(x + 4, y + 2) = arr(i + j - 1, 4)
            .Cells(x + 5, y + 1) = arr(i + j - 1, 6)
            .Cells(x + 6, y + 1) = arr(i + j - 1, 7)
         Next
      Next
End With
Application.ScreenUpdating = True
MsgBox "OK！"
End Sub