Я создал скрипт VBA, который будет считывать значения с одного листа и создавать "метку" на другом листе.
Предполагается, что этот ярлык будет напечатан на специальной бумаге, разделенной на три части.
Поскольку я живу в Швеции, мы используем формат бумаги A4 (297x210 мм). Пластины должны быть 99x210 мм.
Это означает, что каждое значение должно быть напечатано в точном месте на бумаге.
Я делаю это для своей компании, поэтому все копираусы точно такие же.
Такая же модель, такая же версия Windows, та же версия Excel.
Это небольшая часть кода (что имеет отношение к позиционированию текста)
For i = 2 To Lastrow
' Location name
Sheets("Etikett").Range("A" & intRad) = Sheets("Bins").Range("A" & i)
With Sheets("Etikett").Range("A" & intRad & ":K" & intRad)
.MergeCells = True
.Font.Color = clr
.Font.Size = 150
.Font.Bold = True
.HorizontalAlignment = xlCenter
.VerticalAlignment = xlCenter
.BorderAround Weight:=xlThick
.Borders.Color = clr
.Borders(xlEdgeLeft).Weight = xlThick ' this may look odd but is needed
.Borders(xlEdgeRight).Weight = xlThick
End With
'Checknumber
Sheets("Etikett").Range("B" & intRad + 1) = Sheets("Bins").Range("B" & i)
With Sheets("Etikett").Range("B" & intRad + 1 & ":D" & intRad + 1)
.MergeCells = True
.Font.Color = clr
.Font.Size = 100
.NumberFormat = "00"
.Font.Bold = True
.VerticalAlignment = xlCenter
.HorizontalAlignment = xlCenter
End With
' old location
If Sheets("Bins").Range("E" & i) <> "" Then
Sheets("Etikett").Range("K" & intRad + 1) = Sheets("Bins").Range("E" & i)
With Sheets("Etikett").Range("K" & intRad + 1)
.MergeCells = True
.Font.Color = clr
.Font.Size = 8
.Font.Bold = True
.VerticalAlignment = xlBottom
.HorizontalAlignment = xlLeft
End With
End If
' copy already premade barcode or generate barcode if not premade
If Sheets("Bins").Cells(i, 2) < 100 Then
Sheets("0-99").Select
shp = "B" & Right("0" & Sheets("Bins").Cells(i, 2), 2)
Sheets("0-99").Shapes(shp).Select
Else
Sheets("VBA").Select
ThisWorkbook.ActiveSheet.Shapes.SelectAll
Selection.Delete
Code128Generate_v2 30, 0, 40, 2.5, ThisWorkbook.ActiveSheet, Sheets("Bins").Cells(i, 2), 200
ThisWorkbook.ActiveSheet.Shapes.SelectAll
Selection.ShapeRange.Group.Select
End If
'color the barcode
Selection.ShapeRange.Line.ForeColor.RGB = clr
Selection.Copy
Sheets("Etikett").Select
Sheets("Etikett").Range("G" & intRad + 1 & ":J" & intRad + 1).MergeCells = True
' Set rowheights
Sheets("Etikett").Rows(intRad).RowHeight = 135
Sheets("Etikett").Rows(intRad + 1).RowHeight = 115
If Etikettcount Mod 3 = 0 Then ' if it the last label on paper, no space is needed between this and the next.
Range("G" & intRad + 1).Select
intRad = intRad - 1
Else
Sheets("Etikett").Rows(intRad + 2).RowHeight = 25
Range("G" & intRad + 1).Select
End If
ActiveSheet.Paste ' paste barcode
Etikettcount = Etikettcount + 1
intRad = intRad + 3
End If
Next i
Имейте в виду, что это не весь код, но это то, что копирует текст и штрих-коды и помещает их на листе.
На моем компьютере выход выглядит так, как ожидалось:
выход для печати
На других компьютерах последний символ слегка обрезается, а вертикальное выравнивание неверно.
Как я писал ранее, мне нужно, чтобы пустое пространство между листами составляло около 99 мм от вершины, а затем между ними 99 мм.
Я загрузил полный файл, если кто-то хочет его протестировать здесь: http://hoppvader.nu/docs/Streckkod.xlsm
Обратите внимание, что только модуль 3, который используется, module2 - это если вы выберете контрольный номер "Checksiffra", отличный от 00-99.
Любая помощь приветствуется, почему она работает только на моем компьютере.