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