OberonPlace.com Forums

OberonPlace.com Forums (http://forum.oberonplace.com/index.php)
-   Macros/Add-ons (http://forum.oberonplace.com/forumdisplay.php?f=21)
-   -   Problem with macro (conversion to CMYK) (http://forum.oberonplace.com/showthread.php?t=24830)

ajesion 12-04-2019 11:18

Problem with macro (conversion to CMYK)
 
Please help. The macro conversion to CMYK worked in Coreldraw 16. It does not work in CorelDraw 18.

Code:

Public Sub druk()
ActiveDocument.BeginCommandGroup "wCMYK"
    ConvertShapes ActivePage.Shapes
    MsgBox "Konwersja CMYK zako?czona."
ActiveDocument.EndCommandGroup
    Application.Refresh
    ActiveWindow.Refresh
End Sub

Private Sub ConvertShapes(ss As Shapes)
Dim s As Shape
    For Each s In ss
        Select Case s.Type
            Case cdrTextShape, cdrRectangleShape, cdrPolygonShape, _
                cdrLinearDimensionShape, cdrEllipseShape, cdrCurveShape, _
                cdrConnectorShape, cdrBitmapShape
            ConvertShapeColors s
            Case cdrGroupShape
            ConvertShapes s.Shapes
        End Select
        On Error Resume Next
        If Not s.PowerClip Is Nothing Then
            ConvertShapes s.PowerClip.Shapes
        End If
    Next s
End Sub

Private Sub ConvertShapeColors(s As Shape)
    Dim c As FountainColor
'wskazanie koloru wype?nienia
    Select Case s.Fill.Type
        Case cdrUniformFill
            ConvertColor s.Fill.UniformColor
        Case cdrPatternFill
            ConvertColor s.Fill.Pattern.FrontColor
            ConvertColor s.Fill.Pattern.BackColor
        Case cdrFountainFill
            ConvertColor s.Fill.Fountain.StartColor
            ConvertColor s.Fill.Fountain.EndColor
            For Each c In s.Fill.Fountain.Colors
                ConvertColor c.Color
            Next c
    End Select
'wskazanie koloru konturu
    If s.Outline.Type = cdrOutline Then
        ConvertColor s.Outline.Color
    End If
End Sub

Private Sub ConvertColor(c As CorelDRAW.Color)
'zamiana koloru
    c.ConvertToCMYK
    With c
        .CMYKCyan = IIf(.CMYKCyan + .CMYKBlack > 100, 100, .CMYKCyan + .CMYKBlack)
        .CMYKMagenta = IIf(.CMYKMagenta + .CMYKBlack > 100, 100, .CMYKMagenta + .CMYKBlack)
        .CMYKYellow = IIf(.CMYKYellow + .CMYKBlack > 100, 100, .CMYKYellow + .CMYKBlack)
        .CMYKBlack = 0
    End With
'zamiana palety bitmap
    For Each s In ActivePage.Shapes.FindShapes(Type:=cdrBitmapShape)
        If s.Bitmap.Mode <> cdrCMYKColorImage And s.Bitmap.Mode <> cdrGrayscaleImage Then
            s.Bitmap.ConvertTo cdrCMYKColorImage
        End If
    Next s
End Sub



All times are GMT -5. The time now is 05:56.

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