|
Sub 成品卷二维码()
Application.ScreenUpdating = False
Cells(1000, 1000).Select
ActiveSheet.DrawingObjects.Select
Selection.Delete
Dim totalrow As Long
Dim irow As Long
Dim H As Double '二维码高度
Dim Position_Y As Double '二维码垂直位置
totalrow = ActiveSheet.Range("B50000").End(xlUp).Row
For irow = 1 To totalrow
If InStr(Cells(irow, 2), "任务单号:") > 0 And Cells(irow, 3) <> 0 Then
H = Range("G" & irow).MergeArea.Height
With ActiveSheet.OLEObjects.Add(ClassType:="BARCODE.BarCodeCtrl.1")
.Name = "Barcodectrl" & irow
.Object.Style = 11
.Left = Columns("A:F").Width + 0.5
.Top = Position_Y + 0.5
.Height = H - 1.5
.Width = Range("G" & irow).Width - 1
.Object.Value = Cells(irow, 3) & "," & Cells(irow, 6) & "," & Cells(irow + 2, 3) & "," & Cells(irow + 2, 6) & "," & Cells(irow + 3, 3) & "," & Cells(irow + 3, 4) & "," & Cells(irow + 3, 6) & "," & Cells(irow + 4, 3) & "," & Cells(irow + 4, 6)
Cells(irow + 7, 2) = .Object.Value
End With
End If
Position_Y = Position_Y + Range("G" & irow).Height
Next
End Sub
|
|