i want to do indexing in my designs but sometime design has 10 pages sometime 100 and sometime its 500
i will wrote indexing according to the pages for example i have 10 pages book and now i have wrote all the index example are below
abc
def
ghi
jkl
mno
pqr
stu
wvx
yz1
234
now i will create a box of 15mm X10mm height box with a cut mark of 2 mm in bottom right of the box and
add all text to box according to the box for example 1st index in top 1st box, 2nd index in 2nd box etc.
now i group all box with index.
now i have 10 box with index grouped.
now i move them to the bottom right side according to the series
last step i paste 1 by 1 on different pages. 1st index on 1st page, 2nd on 2nd page and soo on
just like this i want macro
paraggoyal said:eskimo is there any way just like this we can move our first top text to first box, second text to to second box etc. text would be in 1 paragraph. ?
I don't know if I understand what you are asking for here.
When I do this, each box + text is a group:
just like this
paraggoyal said: just like this
Sub text_paras_to_rectangles()Dim sr1 As ShapeRangeDim sr2 As ShapeRangeDim para_count As LongDim counter_1 As LongDim s2 As ShapeDim tr As TextRange Optimization = True ActiveDocument.BeginCommandGroup "text paras to rectangles" EventsEnabled = False On Error GoTo ErrHandler Set sr1 = ActiveSelection.Shapes.FindShapes(, cdrRectangleShape) If sr1.Count = 0 Then MsgBox "No rectangles were found in the selection." GoTo ExitSub End If Set sr2 = ActiveSelection.Shapes.FindShapes(, cdrTextShape) If sr2.Count = 0 Then MsgBox "No text shape was found in the selection." GoTo ExitSub Else If sr2.Count > 1 Then MsgBox "More than one text shape was found in the selection." GoTo ExitSub End If End If para_count = sr2(1).Text.Story.Paragraphs.Count If para_count > sr1.Count Then MsgBox "The number of paragraphs in the text shape (" & para_count & ") is more than the number of rectangles (" & sr1.Count & ") in the selection." GoTo ExitSub End If sr1.Sort "@shape1.top>@shape2.top" For counter_1 = 1 To para_count Set tr = sr2(1).Text.Story.Paragraphs(counter_1) Set s2 = ActiveDocument.ActiveLayer.CreateArtisticText(0, 0, tr.Text, , , tr.Font, tr.Size, tr.Bold, tr.Italic, tr.Underline) s2.Fill = tr.Fill s2.CenterX = sr1(counter_1).CenterX s2.CenterY = sr1(counter_1).CenterY Next counter_1 ActiveSelection.Shapes.All.RemoveFromSelectionExitSub: Optimization = False EventsEnabled = True Application.Refresh ActiveDocument.EndCommandGroup Exit SubErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSubEnd Sub
Select the paragraph text shape and all of the rectangles, then run the macro.
Thinking about how you might be using this, this version also groups each piece of text with its rectangle.
Sub text_paras_to_rectangles()Dim sr1 As ShapeRangeDim sr2 As ShapeRangeDim sr3 As New ShapeRangeDim para_count As LongDim counter_1 As LongDim s2 As ShapeDim tr As TextRange Optimization = True ActiveDocument.BeginCommandGroup "text paras to rectangles" EventsEnabled = False On Error GoTo ErrHandler Set sr1 = ActiveSelection.Shapes.FindShapes(, cdrRectangleShape) If sr1.Count = 0 Then MsgBox "No rectangles were found in the selection." GoTo ExitSub End If Set sr2 = ActiveSelection.Shapes.FindShapes(, cdrTextShape) If sr2.Count = 0 Then MsgBox "No text shape was found in the selection." GoTo ExitSub Else If sr2.Count > 1 Then MsgBox "More than one text shape was found in the selection." GoTo ExitSub End If End If para_count = sr2(1).Text.Story.Paragraphs.Count If para_count > sr1.Count Then MsgBox "The number of paragraphs in the text shape (" & para_count & ") is more than the number of rectangles (" & sr1.Count & ") in the selection." GoTo ExitSub End If sr1.Sort "@shape1.top>@shape2.top" For counter_1 = 1 To para_count Set tr = sr2(1).Text.Story.Paragraphs(counter_1) Set s2 = ActiveDocument.ActiveLayer.CreateArtisticText(0, 0, tr.Text, , , tr.Font, tr.Size, tr.Bold, tr.Italic, tr.Underline) s2.Fill = tr.Fill s2.CenterX = sr1(counter_1).CenterX s2.CenterY = sr1(counter_1).CenterY sr3.RemoveAll sr3.Add s2 sr3.Add sr1(counter_1) sr3.Group Next counter_1 ActiveSelection.Shapes.All.RemoveFromSelectionExitSub: Optimization = False EventsEnabled = True Application.Refresh ActiveDocument.EndCommandGroup Exit SubErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSubEnd Sub