i want a unique code of 3 alphanumeric text from a artistic text lines for example
If you create the shapes in one run, it's pretty easy:
Option Explicit'Declaring a variable which is valid in this module during the runtimeDim MyCounter As Integer.....Sub Main()Dim Sh As Shape....
'Reset the counter:MyCounter = 0....
'Create the first shapeSet Sh = ActiveLayer.CreateArtisticText(1, 1, "Txt1")'name the shape with a functionSh.Name = MyShapeName()'repeat this as often as you wantSet Sh = ActiveLayer.CreateArtisticText(2, 1, "Txt2")Sh.Name = MyShapeName()....End Sub'This function will increase the counter and create a string conteinint the counterFunction MyShapeName() As StringMyCounter = MyCounter + 1MyShapeName = "Txt" + Right("000" + Trim(Str(MyCounter)), 3)End Function
If you have to do this in a document where you update from time to time a new page / layer, then you can do this with a function like this:
Function MyShapeName2() As StringDim p As Page, l As Layer, s As Shape, Ch As String, n As Integer, MaxN As IntegerConst TxtID = "Txt"MaxN = 0For Each p In ActiveDocument.Pages For Each l In p.Layers For Each s In l.Shapes If Left(s.Name, Len(TxtID)) = TxtID Then n = Val(Mid(s.Name, Len(TxtID) + 1)) If n > MaxN Then MaxN = n End If Next s Next lNext pMaxN = MaxN + 1MyShapeName2 = TxtID + Right("000" + Trim(Str(MaxN)), 3)End Function
© Corel Corporation. 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 and Conditions / User Guidelines.