OberonPlace.com Forums  

Go Back   OberonPlace.com Forums > Corel User Forums > Corel DESIGNER > Macros/Add-ons

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 28-04-2010, 06:28
gorgo gorgo is offline
Senior Member
 
Join Date: Feb 2010
Posts: 169
Default Custom Set of Macros for document preparation

I'm starting a custom set of macros for my job that prepare a document for sharing with other parts of the company.

#1. delete all shapes/text outside the page (desktop layer).
#2. select all paragraph text on all pages and convert to artistic text.
#3. load blank graphic and text style template (done)
#4. save document as "new location in mydocuments folder".

a little help on creating a 'delete all objects on layer Desktop' which should be all stuff outside the drawing page. I'm sure it's simple, but can't figure it out.
Thanks.

-Greg
Reply With Quote
  #2  
Old 28-04-2010, 08:50
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Check out this post.

-John
Reply With Quote
  #3  
Old 28-04-2010, 11:24
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

Quote:
Originally Posted by runflacruiser View Post
Hi.
Check out this post.

-John
I'm testing this out. Question: How do I make this delete all objects outside the page? I reckon it's as simple as changing moveto or something alone those lines.

-Greg
Reply With Quote
  #4  
Old 28-04-2010, 11:39
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi.
Try this:

Code:
Option Explicit

Sub moveToPage()

Dim s As Shape, sr2 As New ShapeRange
Dim i As Integer, j As Integer
Dim x As Double, y As Double, w As Double, h As Double
Dim docY As Double, docX As Double
Dim moveIt As Boolean
Dim ref As cdrReferencePoint


docY = ActivePage.SizeHeight
docX = ActivePage.SizeWidth



For j = 1 To 9
    For i = 1 To ActivePage.Shapes.Count
        moveIt = False
        ActiveDocument.ReferencePoint = myRef(j)
        Set s = ActivePage.Shapes(i)
        s.GetPosition x, y
        If (s.PositionX < 0 Or s.PositionX > docX) Or (s.PositionY < 0 Or s.PositionY > docY) Then
            moveIt = True
        End If
        
        If moveIt = True Then 'move to layer or do something
            's.MoveToLayer "Desktop" 'move it to your layer
            sr2.Add s
            's.Fill.ApplyUniformFill CreateCMYKColor(100, 0, 0, 0) 'for testing
        End If
    Next i
Next j

If sr2.Count > 0 Then
    sr2.Delete
End If

End Sub

Private Function myRef(i As Integer) As cdrReferencePoint
    
    Select Case i
            Case 1
                myRef = cdrBottomLeft
            Case 2
                myRef = cdrBottomMiddle
            Case 3
                myRef = cdrBottomRight
            Case 4
                myRef = cdrCenter
            Case 5
                myRef = cdrMiddleLeft
            Case 6
                myRef = cdrMiddleRight
            Case 7
                myRef = cdrTopLeft
            Case 8
                myRef = cdrTopMiddle
            Case 9
                myRef = cdrTopRight
    End Select

End Function
-John
Reply With Quote
  #5  
Old 28-04-2010, 12:53
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Delete Shape not on Page

This should work:
Code:
Sub ShapesOutsidePage()
    Dim x As Double, y As Double, w As Double, h As Double
    Dim sr As ShapeRange
    
    ActivePage.GetBoundingBox x, y, w, h 'Get the Page size
    Set sr = ActivePage.Shapes.All 'Get all shapes
    sr.RemoveRange ActivePage.SelectShapesFromRectangle(x, y, x + w, y + h, True).Shapes.All 'Remove Shapes in / touching Page
    sr.Delete
End Sub
Changing the TRUE to FALSE will keep shapes 100% inside the page border. Play with it, you will see what I mean.

-Shelby
Reply With Quote
  #6  
Old 28-04-2010, 12:57
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

THANK YOU THANK YOU JOHN! This works great...so far.

-Greg
Reply With Quote
  #7  
Old 28-04-2010, 13:25
runflacruiser's Avatar
runflacruiser runflacruiser is offline
Senior Member
 
Join Date: Jun 2009
Location: Pigeon Forge, TN USA
Posts: 811
Default

Hi Greg. No problem.
Go with Shelby's...It's much faster.

**I think I made that one to work with cdr12 and below.

-John

Last edited by runflacruiser; 28-04-2010 at 13:29. Reason: ver12
Reply With Quote
  #8  
Old 28-04-2010, 14:40
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

What about this one?

#2. select all paragraph text on all pages and convert to artistic text.
Reply With Quote
  #9  
Old 28-04-2010, 15:28
shelbym's Avatar
shelbym shelbym is offline
Senior Member
 
Join Date: Nov 2002
Location: Cheyenne, WY
Posts: 1,769
Blog Entries: 9
Send a message via ICQ to shelbym Send a message via AIM to shelbym Send a message via MSN to shelbym Send a message via Yahoo to shelbym
Default Convert all Paragraph Text to Artistic

Quote:
Originally Posted by gorgo2 View Post
#2. select all paragraph text on all pages and convert to artistic text.
Here you go: This will work in X4 and above as it uses CQL.
Code:
Sub ConvertParagraphText()
    Dim s As Shape, p As Page
    Dim srParagraph As ShapeRange
    
    For Each p In ActiveDocument.Pages
        Set srParagraph = p.Shapes.FindShapes(Query:="@type='text:paragraph'") 'Get Paragraph TextActivePage.Shapes.FindShapes(Query:="@type='text:paragraph'") 'Get Paragraph Text
        For Each s In srParagraph
            s.Text.ConvertToArtistic
        Next s
    Next p
End Sub
Best of luck,

-Shelby

Last edited by shelbym; 28-04-2010 at 15:29. Reason: added title
Reply With Quote
  #10  
Old 28-04-2010, 15:36
gorgo2 gorgo2 is offline
Senior Member
 
Join Date: Feb 2010
Posts: 107
Default

Good job!

Last one..
#4. save document as "new location in mydocuments folder".

I sort of know this one...but just need a little help.
I need to save the document using the 'save as' function to a specific location like MyDocuments...so this creates a copy of the document file onto my computer while leaving the one on the server alone.
Reply With Quote
Reply


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
Opening document with disabling macros clausm CorelDRAW/Corel DESIGNER VBA 2 09-04-2010 15:06
New X4 Custom Dockers bprice CorelDRAW/Corel DESIGNER VBA 4 21-07-2008 11:11
Custom Palettes? masterchiefph CorelDRAW/Corel DESIGNER VBA 2 23-07-2007 19:41
Custom Palettes via VBA ddonnahoe CorelDRAW/Corel DESIGNER VBA 7 13-11-2006 07:53
Add Custom Buttons.. drg CorelDRAW/Corel DESIGNER VBA 6 17-09-2004 06:36


All times are GMT -5. The time now is 19:35.


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