Hi, I have some shapes to print in columns and rows format based on the user-defined input Value. there are 3 main inputs based conditions: I have code which do most of the work. but without condition
1) No of starting labels(shapes) to skip (blank space in place of shape)
2) No of the labels(shapes) per Row
3) No of Rows Per page
Sheet1
Output Sheet
Following codes I have tried which generate the above pattern. but before print, I need to ask the user three conditions.
[/CODE][/CODE]
Respected team, please help
@mikerickson
@Snakehips
@Domenic
@Fluff
@Eric W
1) No of starting labels(shapes) to skip (blank space in place of shape)
2) No of the labels(shapes) per Row
3) No of Rows Per page
Sheet1
Output Sheet
Following codes I have tried which generate the above pattern. but before print, I need to ask the user three conditions.
VBA Code:
[CODE=vba][CODE=vba]
Sub x()
Dim r As Range, sh As Shape, shCopy As Shape, i As Long, nCol As Long
Dim nLeft As Long, nTop As Long, nRow As Long, j As Long, ctr As Long
' Dim LabelsToSkip As Integer
' Dim LabelsPerRow As Integer
' Dim RowsPerPage As Integer
'LabelsToSkip = 1 'user defined value
'LabelsPerRow = 3 'user defined value
'RowsPerPage = 8 'user defined value
'horizontal gap b/w shape user defined
'vertical gap b/w shape user defined
nCol = 3: nTop = 10: nLeft = 10
Application.ScreenUpdating = False
For Each sh In Worksheets("Output").Shapes
sh.Delete
Next sh
For Each r In Worksheets("Sheet1").Range("B2", Worksheets("Sheet1").Range("B" & Rows.Count).End(xlUp))
For Each sh In Worksheets("Sheet1").Shapes
If Not Intersect(sh.TopLeftCell, r.Offset(, -1)) Is Nothing Then Exit For
Next sh
For i = 1 To r.Value
ctr = ctr + 1
sh.Copy
With Worksheets("Output")
.PasteSpecial
Set shCopy = .Shapes(.Shapes.Count)
If ctr Mod nCol = 1 Then
j = 0
nRow = nRow + 1
End If
shCopy.Top = (nTop * nRow) + (shCopy.Height * (nRow - 1))
shCopy.Left = j * (shCopy.Width + nLeft)
j = j + 1
End With
Next i
Next r
Application.ScreenUpdating = True
End Sub
Respected team, please help
@mikerickson
@Snakehips
@Domenic
@Fluff
@Eric W
Last edited: