标签打印求助

xiaoalanbbb · 发表于 2020-5-26 20:35

本帖最后由 xiaoalanbbb 于 2020-5-28 21:35 编辑

重新上传，求大神协助。谢谢！
求助：
1，点击后能否不要生成新的工作表，而是直接把数据参考SHEET1标签模板样式生成在下面“生成标签”的工作表中。
这样可以避免不断创建新的工作表，而且这样最大的好处是格式固定，方便打印。这样在固定格式内，可以随便调节字体了，行高了，很方便。
相应的，每页打印多少个标签就不需要管啦。
2，当然，能否也直接在生成标签那一个工作表中，自动代码设定当前有数据的区域为打印区域。（因为有数据的区域会变动，函数不好设置）
求高手出手协助。谢谢！！

3190496160 · 发表于 2020-5-27 11:06

Sub 打印标签()
With Sheets("数据表")
r = .Cells(Rows.Count, 2).End(xlUp).Row
ar = .Range("b1:g" & r)
End With
m = UBound(ar) - 1
If m / 3 = Int(m / 3) Then
sl = m / 3
Else
sl = Int(m / 3)
End If
With Sheets("标签页")
  rs = .Cells(Rows.Count, 1).End(xlUp).Row + 20
  .Range("B1:D3,B4,D4,G1:I3,G4,I4,L1:N3,L4,N4") = Empty
  .Rows("6:" & r).Delete
  m = 6
   For i = 1 To sl
      .Rows("1:5").Copy .Cells(m, 1)
      m = m + 5
   Next i
   m = 1
   For i = 2 To UBound(ar) Step 3
      If Trim(ar(i, 1)) <> "" Then
         .Cells(m, 2) = ar(i, 1)
         .Cells(m + 1, 2) = ar(i, 2)
         .Cells(m + 2, 2) = ar(i, 3)
         .Cells(m + 3, 2) = ar(i, 4)
         .Cells(m + 3, 4) = ar(i, 5)
         If i + 1 > UBound(ar) Then GoTo 10
         .Cells(m, 7) = ar(i + 1, 1)
         .Cells(m + 1, 7) = ar(i + 1, 2)
         .Cells(m + 2, 7) = ar(i + 1, 3)
         .Cells(m + 3, 7) = ar(i + 1, 4)
         .Cells(m + 3, 9) = ar(i + 1, 5)
         If i + 2 > UBound(ar) Then GoTo 10
         .Cells(m, 12) = ar(i + 2, 1)
         .Cells(m + 1, 12) = ar(i + 2, 2)
         .Cells(m + 2, 12) = ar(i + 2, 3)
         .Cells(m + 3, 12) = ar(i + 2, 4)
         .Cells(m + 3, 14) = ar(i + 2, 5)
         m = m + 5
10:
      End If
Next i
End With


End Sub

xiaoalanbbb · 发表于 2020-5-27 11:08

谢谢，，，十分感谢

Chip_Kenny · 发表于 2020-5-27 12:10

Sub zz()
Dim n&, m&, MyLabel, r, c, rng As Range, rc(1), pb&
Application.ScreenUpdating = 0
Set rng = Sheets(1).[a1:d4]
MyLabel = rng.Value
c = Split("2|2|2|2|4", "|")
r = Split("1|2|3|4|4", "|")
a = Sheets(2).[a1].CurrentRegion
Sheets(1).Copy
For i = 2 To UBound(a)
If a(i, 7) Then
For j = 1 To a(i, 7)
For n = 0 To UBound(c)
MyLabel(r(n), c(n)) = a(i, 2 + n)
Next
rng.Copy Cells(rc(0) * 5 + 1, rc(1) * 5 + 1)
Cells(rc(0) * 5 + 1, rc(1) * 5 + 1).Resize(4, 4) = MyLabel
m = m + 1
rc(0) = Int(m / 3)
rc(1) = m Mod 3
pb = pb + 1
If pb Mod 15 = 0 Then ActiveSheet.HPageBreaks.Add Before:=Cells(rc(0) * 5 + 1, rc(1) * 5 + 1)
Next
End If
Next
Application.ScreenUpdating = 1
End Sub

复制代码

3190496160 · 发表于 2020-5-27 14:44

标签打印求助.rar (19.2 KB, 下载次数: 16)

xiaoalanbbb · 发表于 2020-5-27 21:58

本帖最后由 xiaoalanbbb 于 2020-5-27 21:59 编辑

Chip_Kenny 发表于 2020-5-27 12:10

高手呀，特别好的功能。但是请问能不能自动生成标签在工作薄已经存在的工作表里。不要总是新生成了一个工作表。谢谢！另外，发现了一个小BUG，就是比如数据只有两条时，还是要打印一行。这个有没有办法来取消。就是说小于三条数据，就是有几条打几条。

Chip_Kenny · 发表于 2020-5-27 22:16

那不是 bug, 把標籤頁的第二第三個空表枱清除即可，其他就不做了。

xiaoalanbbb · 发表于 2020-5-27 23:31

本帖最后由 xiaoalanbbb 于 2020-5-28 00:14 编辑

Chip_Kenny 发表于 2020-5-27 22:16
那不是 bug, 把標籤頁的第二第三個空表枱清除即可，其他就不做了。

那能不能不要生成新的工作表。直接在已有的工作表中生成，比如SHEET 3，并自动跳转到SHEET3查看。谢谢！求高人优化。而且生成的排好的标签，求高人做到两大行之间的间距可以设定。不然这样根本打印不成。谢谢！！

xiaoalanbbb · 发表于 2020-5-28 10:54

求助，谢谢

xiaoalanbbb · 发表于 2020-5-28 12:57

求助高手帮个忙，谢谢

		自动登录	找回密码
密码			免费注册

[求助] 标签打印求助