|
|
大致看了一些你的文件，我理解的需求，
1，对打印数据要整理，以方便打印错误时补打印。
2，数据整合成二维码打印。
看了一下你的代码，可能比较初级，所以，我在代码中加了一些注释，希望你可以理解。
请测试附件。疑问的地方是二维码的内容不是很明确，不知对不对。
（附件中的代码很多来自论坛改写，如果原作者看到请包涵）
- Option Explicit
- Sub A1打印数据整理()
- Dim xrr, i&, arr(), m%, rc&, x%
- Dim x1%, x2%, x3%, x4%
- Application.ScreenUpdating = False
- xrr = Sheets("基础数据").UsedRange
- For i = 2 To UBound(xrr)
- If xrr(i, 9) > 0 And xrr(i, 10) > 0 Then
- x1 = Int(xrr(i, 10) / xrr(i, 9)) '整箱箱数
- x2 = xrr(i, 10) Mod xrr(i, 9) '零头
-
- '如果没有零头，标签枚数=箱数，否则标签枚数=箱数+1
- If x2 = 0 Then x3 = x1 Else x3 = x1 + 1
- '如果没有零头，尾箱标包数=标包数量，否则=零头
- If x2 = 0 Then x4 = xrr(i, 9) Else x4 = x2
-
- For x = 1 To x3
- m = m + 1
- ReDim Preserve arr(1 To 15, 1 To m)
- arr(1, m) = m '序号
- arr(2, m) = "" '打印时间
- arr(3, m) = xrr(i, 1) '订单号
- arr(4, m) = xrr(i, 2) '订单行
- arr(5, m) = "'" & x & "/" & x3 '标签序号
- arr(6, m) = xrr(i, 3) '供应商编码
- arr(7, m) = xrr(i, 4) '供应商名称
- arr(8, m) = xrr(i, 5) '物料编码
- arr(9, m) = xrr(i, 6) '版本
- arr(10, m) = xrr(i, 7) '物料名称
- arr(11, m) = xrr(i, 8) '规格
-
- If x = x3 Then
- arr(12, m) = x4 '本包数量
- Else:
- arr(12, m) = xrr(i, 9) '本包数量
- End If
-
- arr(13, m) = xrr(i, 9) '标包数量
- arr(14, m) = Format(Date, "yyyymmdd") '批号
- arr(15, m) = xrr(i, 11) '库区
- Next
- End If
- Next
- If m = 0 Then Exit Sub
- Sheets("打印数据").Select
- Cells.Select
- Selection.ClearContents
- Sheets("打印数据").Range(Cells(1, 1), Cells(1, 16)) = Array("序号", "打印时间", "订单号", "订单行", "标签序号", "供应商编码", "供应商名称", "物料编码", "版本", "物料名称", "规格", "本包数量", "标包数量", "批号", "库区", "备注") '添加
- Sheets("打印数据").Cells(2, 1).Resize(m, 15) = Application.Transpose(arr)
- ThisWorkbook.Save
- MsgBox "打印数据已整理。"
- Erase xrr
- Erase arr
- Application.ScreenUpdating = True
-
- End Sub
- Sub A2标签打印()
- Sheets("标签模板").Select
- Dim pic
- For Each pic In ActiveSheet.Shapes
- pic.Delete
- Next
- 'Application.ScreenUpdating = False
- Dim ss1$, i%, d As Date, xrr, ph$
- Dim x1%, x2%, x3%
- ph = ThisWorkbook.Path
- xrr = Sheets("打印数据").UsedRange
- For i = 2 To UBound(xrr)
- If xrr(i, 3) <> "" And xrr(i, 16) = "" Then
-
- Sheets("标签模板").Select
-
- With Sheets("标签模板")
- .Cells(2, 2) = xrr(i, 7) '供应商
- .Cells(3, 2) = xrr(i, 8) '物料编码
- .Cells(3, 4) = xrr(i, 6) '供应商编码
- .Cells(4, 2) = xrr(i, 10) '物料名称
- .Cells(5, 2) = xrr(i, 11) '规格
- .Cells(6, 2) = xrr(i, 12) '本包数量
- .Cells(6, 5) = xrr(i, 13) '标包数量
- .Cells(7, 2) = xrr(i, 14) '批号
- .Cells(7, 5) = xrr(i, 15) '库区
- .Cells(8, 1) = "物料编码|版本号|批号|供应商编码|本包数量|EDI|行号|箱号（流水号）"
- End With
-
- ss1 = xrr(i, 8) & "|" & xrr(i, 9) & "|" & xrr(i, 14) & "|" & xrr(i, 6) & "|" & xrr(i, 12) & "|" & "|" & "|" & xrr(i, 1)
- Call wvew_made(ss1)
-
- '===如果不加延时，可能会出错！
- d = Now
- Do While Now - d < TimeValue("00:00:01")
- DoEvents
- Loop
-
- ' On Error Resume Next
- ActiveSheet.Paste '粘贴剪切板内的图片
- Application.CutCopyMode = False
-
- With Selection '图片是唯一的,设置图片：位置和大小
- .ShapeRange.Height = 55
- .ShapeRange.Width = 55
-
- .ShapeRange.Left = Cells(1, 5).MergeArea.Left + 25
- .ShapeRange.Top = Cells(1, 5).MergeArea.Top + 5
- .Name = "xx" & i
- End With
-
- Cells(1, 1).Select
-
- ' ActiveSheet.PrintOut
- '====保存pdf，测试用====
- ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, Filename:= _
- ph & "\第" & i - 1 & "页" & ".pdf", Quality:= _
- xlQualityStandard, IncludeDocProperties:=True, IgnorePrintAreas:=False, from:=1, To:=1, OpenAfterPublish:=False
- '====保存pdf，测试用====
-
- Sheets("打印数据").Select
- Cells(i, 2) = Now
- Cells(i, 16) = "打印完成"
-
- End If
- Next
- ThisWorkbook.Save
- MsgBox "打印完成！"
- 'Application.ScreenUpdating = True
- End Sub
|
|
楼主: 梁笑燕
沪公网安备 31011702000001号 沪ICP备11019229号-2
楼主
发表于 2023-6-12 08:36
