Hi,I really urgently need help....I would like create 12 rectangle in each page which each rectangle consists of data from each 10rows which start from rows 23 until 24022(means 23-33 data will be store in one rectangle and so on.)....Then one sheet can only create 12 rectangle(for example, rows 23-32,33-42,43-52,53-62,63-72,73-82,83-92,93-102,103-112,113-122,123-132,133-142 will store in 12 rectangle,the following rows such as 143-152 and so on will store in another 12 rectangle in a new sheet)........How can I code it???
CODE
'add worksheet
With ActiveWorkbook.Sheets
.Add after:=Worksheets(Worksheets.Count)
End With
'create 3 rectangle vertical and loop 4 time(3*4=12)
For icolumn = 6 To 24
Set mydocument = ActiveSheet
With mydocument.Shapes
.AddShape(msoShapeRectangle, Range(Cells(19, icolumn - 2), Cells(25, icolumn - 4)).Left, Range(Cells(19, icolumn + 2), Cells(25, icolumn + 3)).Top, Range(Cells(19, icolumn), Cells(19, icolumn + 2)).Width, Range(Cells(19, icolumn), Cells(25, icolumn)).Height).Fill.ForeColor.RGB = RGB(221, 221, 221)
.AddShape(msoShapeRectangle, Range(Cells(29, icolumn - 2), Cells(31, icolumn - 4)).Left, Range(Cells(29, icolumn + 2), Cells(31, icolumn + 3)).Top, Range(Cells(29, icolumn), Cells(29, icolumn + 2)).Width, Range(Cells(29, icolumn), Cells(31, icolumn)).Height).Fill.ForeColor.RGB = RGB(204, 255, 153)
.AddShape(msoShapeRectangle, Range(Cells(34, icolumn - 2), Cells(38, icolumn - 4)).Left, Range(Cells(34, icolumn + 2), Cells(38, icolumn + 3)).Top, Range(Cells(34, icolumn), Cells(34, icolumn + 2)).Width, Range(Cells(34, icolumn), Cells(38, icolumn)).Height).Fill.ForeColor.RGB = RGB(221, 221, 221)
End With
icolumn = icolumn + 4
Next icolumn
'retrieve data from each 10 rows
With ActiveSheet
for i=23 to 24022
'data start from rows 23 column A
.Rectangles(1).Characters.Text = _
Join(Evaluate("transpose(" & .Cells(i, 1).Resize(10).Address & ")"),
vbLf)
'data from rows 23 column C
.Rectangles(2).Characters.Text = _
Join(Evaluate("transpose(" & .Cells(i, 1).Offset(0, 2).Resize
(10).Address & ")"), vbLf)
'data from rows 23 column E
.Rectangles(3).Characters.Text = _
Join(Evaluate("transpose(" & .Cells(i, 1).Offset(0, 4).Resize
(10).Address & ")"), vbLf)
i=i+10
Next i
End With
Hope all the experts will have a look on my coding and correct my coding...Thanks...
| 