Hello,
I have to fit numbers to several shape-s like this. I use Fit text to frame method but sometimes it results like this: (the number goes outside to the shape..)
Good quality image: http://www.kepfeltoltes.eu/images/2022/01/23/127111.png
I would need an automatic method what makes the positioning/ resizing of the numbers 100% correct.
The numbering is a part of a macro which I'm using to order the correct numbers...
BTW: I was trying to make the text frame (margin) larger but there is no option for it.
Thanks for everyone who wants to help me!
Zoltán
Hello Zoltan!Try somting like that
Dim s As ShapeSub Macro1() Dim SR As ShapeRange, sT As Shape, s1 As Shape, R As Double Dim X As Double, Y As Double ActiveDocument.Unit = cdrMillimeter Set SR = ActiveSelectionRange Set sT = SR.Shapes.Last ' text Shape Set s1 = SR.Shapes.First ' Frame shape R = s1.SizeHeight / 5 ' Contour offset ContourInMk s1, R X = s.CenterX Y = s.CenterY sT.CenterX = X sT.CenterY = Y s.DeleteEnd SubFunction ContourInMk(sC As Shape, R As Double) Dim eff1 As Effect, SRgrp As ShapeRange, SNew As Shape
Set eff1 = sC.CreateContour(cdrContourInside, R) Set SRgrp = eff1.Separate Set s = SRgrp.Shapes.First s.ConvertToCurves ' temporary shape
End FunctionMy idea is to use Inside Contour for Frame shape to define Text center position X,YTaras
Hello Taras,
The following line is not good as SRgrp stays 'Nothing' after executing this line:
Set SRgrp = eff1.Separate
And then the following line gives exception as the previous line resulted SRgrp to be 'Nothing'.
I am really appreciate your kind help, - I'll try to solve it today, but if you have any idea, please let me know.
Thank you very much!
Note that you must first click on the text shape then on the frame (+Shift)After thet run Macro1Just change this param
R = s1.SizeHeight / 5 ' Contour offsetmake R = 1 then R = 2 ..... to understand
Taras
Yes, the value of R was too high so I changed '/5' to '/25' to make it smaller.
Now this part is working and there is no exception.
From here the problem is that the following code don't set anything
sT.CenterX = XsT.CenterY = Y
I mean, after executing these two lines, both CenterX and Y values remain as they were.
The other problem is that the shape of the objectcountour has very similar size to the original shape...
You can see in the following example: (I moved the countour next to the original shape to illustrate)
calculate the parameter RSub Macro1()Dim SR As ShapeRange, sT As Shape, s1 As Shape, R As DoubleDim X As Double, Y As Double
ActiveDocument.Unit = cdrMillimeter Set SR = ActiveSelectionRange Set sT = SR.Shapes.Last ' text Shape Set s1 = SR.Shapes.First ' Frame shape R = 1 's1.SizeHeight / 5 ' Contour offset5 ContourInMk s1, R If s.Curve.Area > 20 Then R = R + 1 s.Delete GoTo 5 End If X = s.CenterX Y = s.CenterY sT.CenterX = X sT.CenterY = Y s.DeleteEnd Sub