OberonPlace.com Forums  

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

Reply
 
Thread Tools Search this Thread Display Modes
  #1  
Old 13-06-2005, 13:32
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default Select Single Pages...

I have this little macro (CD12), that takes a selected file and imports it into a new document, makes a duplicate, arranges the items and places registration and crop items on the new document. The question I have is, when I select a CDR file that contains multiple pages, how can I select a certain page. For example, say I wanted to select page three of the selected import file to import only, how would I go about doing this?

Code:
Option Explicit
Private Declare Function GetOpenFileName Lib "comdlg32.dll" _
    Alias "GetOpenFileNameA" _
    (pOpenfilename As OPENFILENAME) As Long

Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type
Private Function GetValue(ByVal sValue As String) As Integer
    If sValue = "" Then
        GetValue = 0
    Else
        GetValue = Val(sValue)
    End If
End Function

Private Sub buttonBrowse_Click()
    ShowOpenFile
End Sub

Private Sub buttonCancel_Click()
    Unload Me
End Sub

Private Sub buttonOK_Click()
    If ValidateParams Then
        CreateVinylStreetBanner.Hide
        CreatePageLayout
    End If
End Sub
Private Function ValidateParams() As Boolean
    ValidateParams = True

    If (IsNumeric(boxWidth.Text) = False) Then GoTo ErrWidth
    If (IsNumeric(boxHeight.Text) = False) Then GoTo ErrHeight
    If (IsNumeric(boxSleeve.Text) = False) Then GoTo ErrSleeve
    Exit Function
    
ErrWidth:
    MsgBox "Spacing not numeric : " & boxWidth.Text
    boxWidth.SetFocus
    ValidateParams = False
    Exit Function
ErrHeight:
    MsgBox "Spacing not numeric : " & boxHeight.Text
    boxHeight.SetFocus
    ValidateParams = False
    Exit Function
ErrSleeve:
    MsgBox "Spacing not numeric : " & boxSleeve.Text
    boxSleeve.SetFocus
    ValidateParams = False
    Exit Function

End Function
Public Sub ShowOpenFile()
Dim OFName As OPENFILENAME
Dim sPath As String
Dim GetBackEnd As String
Dim BrowseOpenFile As String
Dim n As String

    OFName.lStructSize = Len(OFName)
    OFName.hwndOwner = 0&
    OFName.hInstance = 0&
    OFName.lpstrFilter = "Image Files" + Chr$(0) + "*.ai;*.cdr;*.eps;*.pdf;*.cmx"
    OFName.lpstrFile = Space$(254)
    OFName.nMaxFile = 255
    OFName.lpstrFileTitle = Space$(254)
    OFName.nMaxFileTitle = 255
    sPath = GetBackEnd
    If sPath = vbNullString Then
        OFName.lpstrInitialDir = "D:\By Customer\"
    Else
        sPath = Left(sPath, InStrRev(sPath, "\") - 1)
        If Len(Dir(sPath, vbDirectory)) > 0 Then
            OFName.lpstrInitialDir = sPath
        Else
            OFName.lpstrInitialDir = "D:\By Customer\"
        End If
    End If
    OFName.lpstrTitle = "Select an image File (*.ai), (*.cdr), (*.cmx), (*.eps), (*.pdf)"
    OFName.flags = 0

    If GetOpenFileName(OFName) Then
        BrowseOpenFile = OFName.lpstrFile
    Else
        BrowseOpenFile = vbNullString
        MsgBox "No file Selected."
    End If
    
    boxFile.Text = BrowseOpenFile

End Sub
Public Sub CreatePageLayout()
    Dim doc As Document
    Dim BrowseOpenFile As String
    Dim OFName As OPENFILENAME
    Dim docH As Long
    Dim docW As Long
    Dim dw As Integer
    Dim dh As Integer
    Dim sl As Integer
    Dim sewn As Integer
    Dim p As Page
    dw = GetValue(boxWidth.Value)
    dh = GetValue(boxHeight.Value)
    sl = GetValue(boxSleeve.Value)
    docH = dh + dh + sl
    docW = dw + 1
    
    Set doc = CreateDocument()
        doc.Unit = cdrInch
        ActiveDocument.Pages(0).SetSize docW, (docH + 0.5)
    With ActivePage
        .Orientation = cdrPortrait
        .SizeWidth = docW
        .SizeHeight = (docH + 0.5)
        .PrintExportBackground = False
        .Bleed = 0#
        .Background = cdrPageBackgroundNone
    End With
    
    With ActiveLayer
        .CreateGuide 0, 0, 0, docH
        .CreateGuide docW, 0, docW, docH
        .CreateGuide (docW - 0.5), 0, (docW - 0.5), docH
        .CreateGuide 0.5, 0, 0.5, docH
        .CreateGuide 0, 0, docW, 0
        .CreateGuide 0, sl, docW, sl
        .CreateGuide 0, (dh - sl), docW, (dh - sl)
        .CreateGuide 0, dh, docW, dh
        .CreateGuide 0, (dh + sl), docW, (dh + sl)
        .CreateGuide 0, (dh * 2), docW, (dh * 2)
        .CreateGuide 0, (dh * 2 + (sl + 0.5)), docW, (dh * 2 + (sl + 0.5))
    End With
    
    If boxFile.Text <> "" Then
        Dim s5 As Shape, s6 As Shape
        Dim x As Double, y As Double, q As Double, z As Double
        Dim nsy As Double
        ActiveLayer.Import boxFile.Text, cdrAutoSense
        Set s5 = ActiveSelection
        s5.Move 0#, 0#
        ActiveDocument.ReferencePoint = cdrCenter
        s5.GetPosition x, y
        s5.PositionX = (docW / 2)
        s5.PositionY = (s5.SizeHeight / 2)
        Set s6 = s5.Clone(0, dh)
        s6.Rotate 180
        s6.GetPosition x, y
        s6.PositionX = (docW / 2)
        s6.PositionY = (s6.SizeHeight + (s6.SizeHeight / 2))
    End If
    
    Dim ext As Layer
    Dim sq As Shape
    Set ext = ActivePage.CreateLayer("Extras")
    ActivePage.Layers("Extras").Activate
    ActiveLayer.CreateRectangle 0, 0, docW, sl
    ActiveSelection.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
    ActiveLayer.CreateCurveSegment 0, (dh - sl), docW, (dh - sl)
    ActiveSelection.Outline.Color.CMYKAssign 0, 0, 0, 0
    ActiveSelection.Outline.Width = 0.028
    ActiveLayer.CreateCurveSegment 0, dh, 2, dh
    ActiveSelection.Outline.Color.CMYKAssign 0, 0, 0, 0
    ActiveSelection.Outline.Width = 0.028
    ActiveLayer.CreateCurveSegment (docW - 2), dh, docW, dh
    ActiveSelection.Outline.Color.CMYKAssign 0, 0, 0, 0
    ActiveSelection.Outline.Width = 0.028
    ActiveLayer.CreateCurveSegment 0, (dh * 2), 2, (dh * 2)
    ActiveSelection.Outline.Color.CMYKAssign 0, 0, 0, 0
    ActiveSelection.Outline.Width = 0.028
    ActiveLayer.CreateCurveSegment (docW - 2), (dh * 2), docW, (dh * 2)
    ActiveSelection.Outline.Color.CMYKAssign 0, 0, 0, 0
    ActiveSelection.Outline.Width = 0.028

End Sub
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #2  
Old 14-06-2005, 10:02
RobC
Guest
 
Posts: n/a
Default

The easiest way to do this is to import the full file to a blank scratch document, copy the page you want to the clipboard, close the scratch document, and paste your clipboard into whatever document you want.
Reply With Quote
  #3  
Old 14-06-2005, 10:20
ddonnahoe's Avatar
ddonnahoe ddonnahoe is offline
Senior Member
 
Join Date: Jan 2004
Location: Louisville, KY
Posts: 552
Send a message via ICQ to ddonnahoe Send a message via AIM to ddonnahoe Send a message via MSN to ddonnahoe Send a message via Yahoo to ddonnahoe
Default

Copy/Paste method is undesireable in this case. Copy/Paste has a glitch in CD12 that I trust will be fixed in 13.
__________________
Sean
Waiting for a ride in the T.A.R.D.I.S.
Reply With Quote
  #4  
Old 14-06-2005, 13:41
Alex's Avatar
Alex Alex is offline
Administrator
 
Join Date: Nov 2002
Posts: 1,940
Blog Entries: 4
Default

I don't think you have a lot of choice here. There is only one way I can see that you can do this - open a file first delete all pages but the one you need to import and save to a temp file then import that temp file into your current document...

Here is an example. It imports the page 2 of Graphic1.cdr into the current document.

Code:
Sub TestImportPage()
    Dim CurDoc As Document
    Dim DocToImport As Document
    Dim PageToKeep As Page, p As Page
    
    Set CurDoc = ActiveDocument
    
    Set DocToImport = OpenDocument("C:\Temp\Graphic1.cdr")
    Set PageToKeep = DocToImport.Pages(2)
    For Each p In DocToImport.Pages
        If Not p Is PageToKeep Then
            p.Delete
        End If
    Next p
    DocToImport.SaveAs "C:\Temp.cdr"
    DocToImport.Close
    
    CurDoc.ActiveLayer.Import "C:\Temp.cdr"
    Kill "C:\Temp.cdr"
End Sub
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
How to select all shape ? -=HKLC=- CorelDRAW/Corel DESIGNER VBA 1 25-10-2004 01:10
Select all nodes if the subpath d-signer CorelDRAW/Corel DESIGNER VBA 2 13-05-2004 00:47
Select All ddonnahoe CorelDRAW/Corel DESIGNER VBA 4 10-02-2004 10:14
VBA Select Printer? Jon Lorber CorelDRAW/Corel DESIGNER VBA 1 12-12-2003 10:36
Select objects inside another shelbym CorelDRAW/Corel DESIGNER VBA 1 25-11-2003 17:01


All times are GMT -5. The time now is 21:46.


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