need help but situation has multiple challenges

paraggoyal
over 7 years ago

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

Parents Reply
  • over 7 years ago in reply to paraggoyal

    paraggoyal said:

    just like this

    Sub text_paras_to_rectangles()
    Dim sr1 As ShapeRange
    Dim sr2 As ShapeRange
    Dim para_count As Long
    Dim counter_1 As Long
    Dim s2 As Shape
    Dim 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 "Number of paragraphs (" & para_count & ") in the selection does not match 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.RemoveFromSelection

    ExitSub:
        Optimization = False
        EventsEnabled = True
        Application.Refresh
        ActiveDocument.EndCommandGroup
        Exit Sub

    ErrHandler:
        MsgBox "Error occurred: " & Err.Description
        Resume ExitSub
    End Sub

    Select the paragraph text shape and all of the boxes, then run the macro.

Children
No Data

© Corel Corporation. All rights reserved. The content herein is in the form of a personal web log ("Blog") or forum posting. As such, the views expressed in this site are those of the participants and do not necessarily reflect the views of Corel Corporation, or its affiliates and their respective officers, directors, employees and agents. Terms of Use / Privacy​ ​/ ​Cookies / Terms and Conditions / User Guidelines.