标签套打及二维码生成

xiakor

各位老师，晚上好。
请问附件内容如何用VBA做出来？万分感谢。
要求：
1. 二维码包含多个内容，用“|”符号间隔开；
2. 标签、二维码尺寸可以设置
再次感谢。

aman1516

是将文本1~文本12 用“｜”合并作业二维码内容吗？

xiakor

aman1516 发表于 2020-4-14 20:03
是将文本1~文本12 用“｜”合并作业二维码内容吗？

是的，谢谢您的关注。

aman1516

请测试： test.rar (26.85 KB, 下载次数: 342)

2020-4-14 22:13 上传

点击文件名下载附件

aman1516

"简单点，网络版代码

1. Sub 生成二维码()
   
2.     Dim r, arr, i, c, j, k, s As String, rr, b As Boolean, n, ewm
   
3.     Dim Ran As Range
   
4.     On Error Resume Next
   
5.     Call 清空内容及二维码
   
6.     With Sheets("二维码内容")
   
7.     r = .[A65536].End(xlUp).Row
   
8.     arr = .Range("A1:M" & r).Value
   
9.     End With
   
10.     b = True
    
11.     For i = 2 To UBound(arr)
    
12.         s = "": n = 2 + (Int(i / 2) - 1) * 13
    
13.         For c = 2 To UBound(arr, 2)
    
14.             If s = "" Then s = arr(i, c) Else s = s & "|" & arr(i, c)
    
15.         Next
    
16.         With Sheets("标签")
    
17.         If b = True Then
    
18.            For c = 2 To UBound(arr, 2) - 1
    
19.               .Range("B" & n + c - 2) = arr(i, c)
    
20.            Next
    
21.            .Range("D" & n + 3) = arr(i, UBound(arr, 2))
    
22.            Set Ran = .Range("C" & n).MergeArea
    
23.            b = False
    
24.         Else
    
25.            For c = 2 To UBound(arr, 2) - 1
    
26.               .Range("G" & n + c - 2) = arr(i, c)
    
27.            Next
    
28.            .Range("I" & n + 3) = arr(i, UBound(arr, 2))
    
29.            Set Ran = .Range("H" & n).MergeArea
    
30.            b = True
    
31.         End If
    
32.         ewm = 生成二维码Fun(s, Ran)
    
33.         Application.Wait Now + TimeValue("00:00:02")
    
34.         End With
    
35.     Next
    
36.     MsgBox "ok!"
    
37. End Sub
    
38. 
    
39. Sub 清空内容及二维码()
    
40.     Dim myshape As Shape
    
41.     On Error Resume Next
    
42.     Application.ScreenUpdating = False
    
43.     For Each myshape In ActiveSheet.Shapes
    
44.        'If myshape.Type = msoPicture Then
    
45.        If myshape.Left < Range("K1").Left Then
    
46.           myshape.Delete
    
47.        End If
    
48.     Next
    
49.     Dim r, arr, i, c, j, k, s As String, rr, b As Boolean, n, ewm
    
50.     On Error Resume Next
    
51.     r = Sheets("二维码内容").[A65536].End(xlUp).Row
    
52.     b = True
    
53.     For i = 2 To r
    
54.         n = 2 + (Int(i / 2) - 1) * 13
    
55.         With Sheets("标签")
    
56.         If b = True Then
    
57.            For c = 2 To 12
    
58.               .Range("B" & n + c - 2) = ""
    
59.            Next
    
60.            .Range("D" & n + 3) = ""
    
61.            b = False
    
62.         Else
    
63.            For c = 2 To 12
    
64.               .Range("G" & n + c - 2) = ""
    
65.            Next
    
66.            .Range("I" & n + 3) = ""
    
67.            b = True
    
68.         End If
    
69.         End With
    
70.     Next
    
71.     Application.ScreenUpdating = True
    
72. End Sub
    
73. 
    
74. Function 生成二维码Fun(ByVal Str As String, ByVal Rng As Range)
    
75.     Dim CelH, CelW, PicH, PicW, Picbili
    
76.     On Error Resume Next
    
77.     Rng.Select
    
78.     'URL = "https://api.qrserver.com/v1/create-qr-code/?size=150x150&data=" & Str
    
79.     URL = "http://e.anyoupin.cn/pdo/eh/a10/create_qr.php?value=" & Str
    
80.     ActiveSheet.Pictures.Insert(URL).Select
    
81.     With Selection
    
82.         CelH = Rng.Height
    
83.         CelW = Rng.Width
    
84.         PicH = .Height
    
85.         PicW = .Width
    
86.         Picbili = Application.WorksheetFunction.Min(CelH / PicH, CelW / PicW) * 0.98
    
87.         .Height = PicH * Picbili
    
88.         .Width = PicW * Picbili
    
89.         .Top = Rng.Top + (Rng.Height - .Height) / 2 '垂直居中:
    
90.         .Left = Rng.Left + (Rng.Width - .Width) / 2   '水平居中:
    
91.     End With
    
92. End Function

复制代码

xiakor

aman1516 发表于 2020-4-14 22:15
请测试：

运行成功。不过，需要在标签sheet中运行才可以，另外，需要在VBE环境中运行，有更加方便的方法吗？

aman1516

xiakor 发表于 2020-4-14 22:24
运行成功。不过，需要在标签sheet中运行才可以，另外，需要在VBE环境中运行，有更加方便的方法吗？

自己加个按钮调用过程就行了

xiakor

aman1516 发表于 2020-4-14 22:35
自己加个按钮调用过程就行了

感谢您的帮助，我试一试。

xiakor

aman1516 发表于 2020-4-14 22:15
请测试：

您好，我注意到您给代码里有URL = "http://e.anyoupin.cn/pdo/eh/a10/create_qr.php?value=" & Str。单机可以用吗？

weikywei

我也有类似问题，可以有哪位老师帮我一下，此表为客户A导出的当天销售表，现要求三个料依据客户最小包装数来打印相应的标签（三个料号可以有不同的包装数要求，所以要求当天销售表里每一行依据不同包装数来分，）现在在客户A标签里案例打印其中一个货品编号的标签（我都是手工来做），希望有什么方法来自动产生，我只要输入不同料号不同最小包装数就可以自动产生标签。