excel - 根据数据表在新表上插入条目

Question

从我们的绘图程序中，我们收到一张带有锯切板材数据的表格。我们想为每个独特的盘子制作一个贴纸。

这个想法是，将数据重新排列为新工作表上的贴纸格式。

以 jpeg 图像为例。

Sub Platen_stickers()
Application.ScreenUpdating = False

Dim i As Long
Dim j As Long
Dim xLast As Long
Dim rw As Range
Dim aantalrng As Range
Dim aantal As Range
Dim plaattype As Range
Dim Merk As String, Label As String, Lengte As String, Breedte As String
Dim stickeraantal As Byte, stickergemaakt As Byte
Dim sticker As Range
Dim row As Range
Dim x As Long

On Error Resume Next
xLast = ActiveWorkbook.Sheets(1).Cells(Rows.Count, "B").End(xlUp).row 'searching last filled cell in column B

For i = 8 To xLast Step 1
    If Sheets(1).Cells(i, "B").Value2 = "Code" Then 'searching for header "Code" in column B
        Set plaattype = Sheets(1).Cells(i + 1, "B") 'defining the cell below "Code" as range "plaattype"
        Set aantal = plaattype.Offset(0, 2) 'defining cell in row below "Code" and in column D as range "aantal"
        Set aantalrng = Range(aantal, aantal.End(xlDown)) 'defining all numbers in column D under this header as range "aantalrng"

        'inserting new sheet for stickers after current last sheet
    
        ActiveWorkbook.Sheets.Add After:=ActiveWorkbook.Worksheets(ActiveWorkbook.Worksheets.Count)
        ActiveSheet.Name = plaattype.Value2 'editing sheet name to current type
    
        Set sticker = ActiveSheet.Range(1, 1) 'defining cell A1 of current sheet as current sticker
    
        With ActiveSheet.Range("A1:F31") 'adjusting cell dimensions of range A1:F32 to sticker format (96 sticker per sheet)
            .Columns("A:F").ColumnWidth = 18.14
            .HorizontalAlignment = xlCenter
            .VerticalAlignment = xlCenter
        End With
        For Each rw In ActiveSheet.Range("A1:F32").Rows
            If rw.row Mod 2 = 0 Then
                rw.RowHeight = 5.25
            Else: rw.RowHeight = 53.25
            End If
        Next rw
        With ActiveSheet.PageSetup 'adjusting print settings to fit stickersheet
            .CenterHorizontally = True
            .CenterVertically = True
            .LeftMargin = Application.CentimetersToPoints(0)
            .RightMargin = Application.CentimetersToPoints(0)
            .TopMargin = Application.CentimetersToPoints(0.6)
            .BottomMargin = Application.CentimetersToPoints(0.6)
            .HeaderMargin = Application.CentimetersToPoints(1.3)
            .FooterMargin = Application.CentimetersToPoints(1.3)
            .Zoom = 87
        End With
    
        x = 1 'setting sticker count on 1
    
        'creating the actual sticker
        For Each row In aantalrng 'running through current data for creating stickers
            stickergemaakt = 0 'resetting counter made sticker in this row
            stickeraantal = aantalrng.Cells(row, 1).Value 'checking how many stickers this row needs making (=value of column D)
            Do Until stickergemaakt > stickeraantal 'looping until made stickers is needed stickers
                Merk = aantalrng.Cells(row, 1).Offset(0, -1).Value 'collecting sticker input
                Label = aantalrng.Cells(row, 1).Offset(0, -3).Value
                Lengte = aantalrng.Cells(row, 1).Offset(0, 1).Value
                Breedte = aantalrng.Cells(row, 1).Offset(0, 2).Value
                sticker.Value = Merk & "  " & Label & vbCrLf & Lengte & " x " & Breedte & " mm" & vbCrLf & plaattype 'writing sticker input in format on current cell on sticker sheet
                If x < 6 Then
                    Set sticker = sticker.Offset(0, 1) 'adjusting to new empty sticker cell => next column
                    x = x + 1
                ElseIf x = 6 Then
                    sticker = sticker.Offset(1, -6) 'until reached 6 columns, then next row to start again
                    x = 1
                End If
               stickergemaakt = stickergemaakt + 1 'adding counter made sticker with 1
            Loop
            stickeraantal = 0 'resetting number of stickers needed to zero for next row
        Next row
    
    End If
Next

Application.ScreenUpdating = True

End Sub

第一部分，插入额外的纸张并调整贴纸尺寸，在我的示例文件中工作。

第二部分，用数据填充贴纸，我无法开始。
我怀疑我在声明每个标题的范围时做错了。但是无论我在其中进行什么调整，第二部分都不起作用，有时第一部分也不起作用。

标签： excelvba