OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Developer Forums > VBA > CorelDRAW/Corel DESIGNER VBA

Thread Tools Search this Thread Display Modes
Old 03-09-2005, 13:00
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836
Default musthave macro: REPEAT LAST COMMAND custom number of times

Sometimes one needs to replicate/transform/move some object big number of times uniformly, usually you just press and hold Ctrl-R then after some time release, select what you got and so you see how many objects there are...;-) hehe
This simple macro asks number of repeations and does Ctrl-R for you precisely number of times specified with progress indicator.
Sub repeatLast()
   dim stat As AppStatus, i as long, reps as long
   On Error Resume Next
   reps = Abs(Int(CDbl(InputBox("repeat last command number of times:", "Auto repeater", "2"))))
   Set stat = Application.Status: stat.BeginProgress CanAbort:=True
   If reps = 0 Then Beep: Exit Sub
   For i = 1 To reps
      stat.Progress = i / reps * 100
      stat.SetProgressMessage "Repeating..." & Str(i) & " / " & Str(reps)
      If stat.Aborted Then MsgBox "Command repeated " & Str(i) & " out of " & str(reps) & " times": Exit For
End Sub
the only drawback is that after,say,100 reps you lose your undo info prior to executing this macro, because I couldn't manage to make BeginCommandGroup/EndCommandGroup work - they spoil activedocument.repeat state ;-(

I assigned this macro to CtrlShiftR. I'm really happy;-)))
Reply With Quote
Old 03-09-2005, 20:27
Posts: n/a
Default A separete rutin for Begin/EndCommandGroup

Hi! Here is the answer how to make onestep undo any macro (it's also speed up the execution with turn off what may and create an minimal errorhandling...):

Sub AnyWhatYouWant()

Const MakroTitle as String = "Here is your makro name's place"
Dim ErrorCode As ErrObject

' First rutins to check if any document is open
' and have other stuff to do what you want...

Speeder True, MakroTitle

' Place of your code: exit with GoTo ERRORHANDLING
' or enabling Speeder disabled features any other way...
' End of the execution

ErrorCode = Err
On Error GoTo 0
Speeder false
if ErrorCode <> 0 then Err.Raise ErrorCode

End Sub

Public Sub Speeder(State As Boolean, Optional UndoTitle As String = "Makro execution")

If State Then
   ActiveDocument.BeginCommandGroup UndoTitle
   Optimization = True
   EventsEnabled = False
   ActiveDocument.SaveSettings "Speeder"
   ActiveDocument.PreserveSelection = False
   ActiveDocument.RestoreSettings "Speeder"
   EventsEnabled = True
   Optimization = False
End If

End Sub
Ok, it's easy. The only problem is that no way (or just I don't know how) to check if any "undomaker" is active. If you start CommandGroup twice without quiting first, you may get corruption without any errormessage, doesn't meter the other title, if I'm well. So be carefull with robustus code, what may contain procedures calling another procedures what also may call Speeder...

Last edited by petig; 03-09-2005 at 20:39.
Reply With Quote
Old 04-09-2005, 08:40
wOxxOm's Avatar
wOxxOm wOxxOm is offline
Senior Member
Join Date: Mar 2005
Posts: 836

to petig: I use similar procs, but if I call begincommandgroup, then activedocument.repeat won't repeat previous command, I tried in my macro, no way.
Reply With Quote
Old 04-09-2005, 12:08
Posts: n/a

Oh, yes! Exuse me, it was late night when I read your post, I didn't understand well your last sentence. You're right, no way...

Last edited by petig; 04-09-2005 at 12:11.
Reply With Quote

Currently Active Users Viewing This Thread: 1 (0 members and 1 guests)
Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is On
HTML code is Off

Forum Jump

Similar Threads
Thread Thread Starter Forum Replies Last Post
New macro to clip curves w.r.t. a border Gerard Hermans Macros/Add-ons 0 09-06-2003 07:50

All times are GMT -5. The time now is 04:53.

Powered by vBulletin® Version 3.8.1
Copyright ©2000 - 2023, Jelsoft Enterprises Ltd.
Copyright © 2011, Oberonplace.com