Hello,Please make a macro:
1. I write 7 and around the number circle as an example.2. I select the sample, created in step 13. I run macro1 /must be created/ 4. I click on page anywhere and at click point appears 8.The printout should look like the example created in step 1 5. I click on other place on same page or on other page and appear 9 The printout should look like the example created in step 15.To stop macro I click on sample, created in step 1 or......one other actionGreetings!
To terminete macto just click out of pageSub From1To99() Dim s As Shape, s1 As Shape Dim i%, X As Double, Y As Double, pause% Dim Shift As Long, b As Boolean, SR_New As ShapeRange ActiveDocument.Unit = cdrMillimeter pause = 10 b = False While Not b i = i + 1 b = ActiveDocument.GetUserClick(X, Y, Shift, pause, False, cdrCursorSmallcrosshair) If X > ActivePage.LeftX And X < ActivePage.RightX Then If Y > ActivePage.BottomY And Y < ActivePage.TopY Then Set SR_New = New ShapeRange Set s = ActiveLayer.CreateEllipse2(X, Y, 10, 10) SR_New.Add s Set s1 = ActiveLayer.CreateArtisticText(X, Y, i) ', , , fntNm) SR_New.Add s1 s1.CenterX = s.CenterX s1.CenterY = s.CenterY SR_New.Group ActiveDocument.ClearSelection Else b = True End If Else b = True End If If i = 99 Then b = True WendEnd Sub
This has just a small modification made to another macro that I had already written to "paste where I click".
To use this, you would:
Sub JQ_Paste_Where_I_Click_Multi_Increment_Integer_Text() Dim dblX As Double Dim dblY As Double Dim lngShiftState As Long Dim blnGotClick As Boolean Dim blnDone As Boolean Dim sr As ShapeRange Dim sLabelText As Shape Dim lngNextIncrement As Long Const strMacroName = "Paste Where I Click Increment Integer Text" On Error GoTo ErrHandler If Not ActiveDocument Is Nothing Then If Not Application.Clipboard.Empty Then Do Until blnDone get_coordinates_from_click dblX, dblY, lngShiftState, 10, True, cdrCursorSmallcrosshair, blnGotClick If blnGotClick Then ActiveDocument.BeginCommandGroup "PWIC Incr Int" Set sr = ActiveLayer.PasteEx If sr.Count > 0 Then sr.SetPositionEx cdrCenter, dblX, dblY '----------------------------------- 'added to increment text label lngNextIncrement = lngNextIncrement + 1 Set sLabelText = sr.Shapes.FindShape(, cdrTextShape) sLabelText.Text.Story = CStr(CLng(sLabelText.Text.Story) + lngNextIncrement) '----------------------------------- End If ActiveDocument.EndCommandGroup Else blnDone = True End If Loop Else MsgBox "Clipboard is empty.", vbExclamation, strMacroName End If Else MsgBox "No document is active.", vbExclamation, strMacroName End If ExitSub: If blnGotClick Then ActiveDocument.EndCommandGroup Refresh End If Exit Sub ErrHandler: MsgBox "Error occurred: " & Err.Description Resume ExitSub End Sub Sub get_coordinates_from_click(ByRef ClickX As Double, ByRef ClickY As Double, ByRef ShiftState As Long, ByVal Timeout As Long, ByVal Snap As Boolean, ByVal CursorShape As cdrCursorShape, ByRef ClickMade As Boolean) Dim dblClickX As Double Dim dblClickY As Double Dim lngShiftState As Long Dim blnCancelled As Boolean blnCancelled = True blnCancelled = ActiveDocument.GetUserClick(dblClickX, dblClickY, lngShiftState, Timeout, Snap, CursorShape) If blnCancelled = False Then ClickX = dblClickX ClickY = dblClickY ShiftState = lngShiftState ClickMade = True Else ClickMade = False End If End Sub
Here is a video showing what it looks like in use:
Be aware that the modifications I made to this macro do not have any "safety features". It does not check to see that you have exactly one text shape, or that the text represents an integer number.
Hello, Thanks for the reply! There are some valuable things in this macro, but it doesn't work the way I need it to, namely: If the group we created containing a number in a circle or square or rectangle etc. contains the number 3, then on the first mouse click the next group should contain 4, i.e. +1 from the number of the original. In this sense, the 99 limit is redundant. Second - each subsequent group should look like the first, this is our pattern - font, size, color, etc.
Здравейте,Благодаря за отговора!Има някои ценни неща в този макрос, но той не работи както ми трябва, а именно:Ако създадената от нас група, съдържаща цифра в кръг или квадрат или правоъгълник и т.н. съдържа цифра 3, то при първото щракане с мишката следващата група трябва да съдържа 4, т.е. +1 от числото на оригинала. В този смисъл ограничението 99 е излишно. Второ - всяка следваща група трябва да изглежда както първата, това е нашият образец - шрифт, размер, цвят и т.н.
Sub DulpicateToClick() Dim s As Shape, s1 As Shape, SR As ShapeRange Dim i%, X As Double, Y As Double, pause% Dim Shift As Long, b As Boolean, SR_New As ShapeRange
ActiveDocument.Unit = cdrMillimeter pause = 10 Set SR = ActiveSelectionRange For Each s In SR If s.Type = cdrTextShape Then i = Int(s.Text.Story.Text) Exit For End If Next s s.RemoveFromSelection Set SR = ActiveSelectionRange b = False While Not b i = i + 1 b = ActiveDocument.GetUserClick(X, Y, Shift, pause, False, cdrCursorSmallcrosshair) If X > ActivePage.LeftX And X < ActivePage.RightX Then If Y > ActivePage.BottomY And Y < ActivePage.TopY Then Set SR_New = SR.Duplicate Set s1 = s.Duplicate s1.Text.Story.Text = i s1.CenterX = X s1.CenterY = Y SR.CenterX = X SR.CenterY = Y ActiveDocument.ClearSelection Else b = True End If Else b = True End If If i = 99 Then b = True WendEnd Sub
Hello, There are several valuable techniques in this macro. Thank you for the guidance. The macro doesn't work as I need it to,but that's because I'm trying it with Corel X3 - a rather archaic version, but it works solidly and serves me well. I'll have to make some tweaks to get things working in Corel X3. I will try it later with Corel X5 and Corel X8. I'll probably have to make some changes there too.Greetings!