Corel FORUM

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Witam,
mam krzyżówkę w RGB, potrzebna jest zamiana na CMYK, 100%K, czarny nadrukowany.
Wszystko w Corel X6.

krz.rar

Pobierz Plik ściągnięto 438 raz(y) 146.44 KB

chezare

A ja nie mam krzyżówki, za to mam X3 :-)

Nie bardzo rozumiem, nie wiesz jak to zrobić, czy nie masz X6?
Ja bym Ci zamienił, albo powiedział jak to zrobić, ale musiałbym mieć cdr w wersji 13, bo tak to nie wiem czy to RGB, to jeden kolor, czy cała tęcza?

tegraf

Chezare, koledze chodzi o makro, które to będzie robiło teraz i w przyszłości.
Przecież dał to tutaj > Makra.

Gdyby chciał taką trywialną zamianę, to dałby to do działu "Dam zlecenie".

chezare

Ja się rano zastanawiałem o co chodzi Tegrafowi? :-)

Teraz do mnie dotarło, że musiałem być chyba lekko oczadziały kiedy to pisałem?
Na szczęście nie mam X6, to nie będę kombinował, choć zadanie wydaje się niezbyt skomplikowane?
Zresztą następną krzyżówkę kolega narysuje już w cmyku, to po co makro? :-)

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Krzyżówka jest importowana do Corela z innego programu po to, aby ją zamienić na CMYK.

bidon184

ja to sobie pobrałem,i powiem tak,po grzyba w tej krzyżówce dwa kontury na pole :roll:

,mało tego w niektórych polach są dwa a w innych jeden,totalnie tego nie jarze :cry:

chezare

To ja się tylko zapytam. Czy to jest jakiś specjalizowany program do rysowania krzyżówek?
Bidonik mógłbyś mi zapisać krzyżówkę do 13 wersji?

bidon184

a prosze bardzo w cdr12

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Krzyżówka jest stworzona w specjalnym programie, ale w RGB.

chezare

Zadanie byłoby banalnie proste jest jednak drobny kłopot.
Nie ma problemu z konwersją rgb na cmyk, nie ma problemu z włączeniem nadrukowania, problem jest w tym, że w normalnym dokumencie Corela kolory rgb 0/0/0 i 255/255/255 oraz w cmyk 0/0/0/0 i 0/0/0/100 mają zdefiniowane nazwy i nazywają się odpowiednio White i Black albo w polskiej wersji Biały i Czarny. W dokumencie kolegi te kolory nie mają nazw, a ja póki co po nazwie mogę znaleźć czarny i biały bez problemu, ale nie wiem jak przeczytać wartość składowych koloru. Konwersja rgb na cmyk działa elegancko, ale omija wspomniane kolory. Rozwiązanie już prawie widzę :-)

chezare

Bidon ma rację. W Twoim dokumencie jest totalny bałagan.
Nie wiem na czym polega to co robi ten program od krzyżówek, w Corelu taką krzyżówkę łącznie z wpisaniem tekstów można zrobić w 10 min.
Bałaganu skrypt nie likwiduje, ale w 12 zamienia kolory rgb na cmyk i włącza nadrukowanie dla czarnego.

Sub RGB_to_CMYK()
Optimization = True

For i = 1 To ActivePage.Shapes.Count

If ActivePage.Shapes(i).Fill.UniformColor.Type = cdrColorRGB Then
ActivePage.Shapes(i).Fill.UniformColor.ConvertToCMYK
End If

If ActivePage.Shapes(i).Outline.Color.Type = cdrColorRGB Then
ActivePage.Shapes(i).Outline.Color.ConvertToCMYK
End If

If ActivePage.Shapes(i).Outline.Color.Name = "Black" Or ActivePage.Shapes(i).Outline.Color.Name = "Czarny" Then
ActivePage.Shapes(i).OverprintOutline = True
End If

If ActivePage.Shapes(i).Fill.UniformColor.Name = "Black" Or ActivePage.Shapes(i).Fill.UniformColor.Name = "Czarny" Then
ActivePage.Shapes(i).OverprintFill = True
End If

If ActivePage.Shapes(i).Type = cdrTextShape And (ActivePage.Shapes(i).Fill.UniformColor.Name = "Black" Or ActivePage.Shapes(i).Fill.UniformColor.Name = "Czarny") Then
ActivePage.Shapes(i).CreateSelection
ActiveSelection.OverprintFill = True
End If

Next i

ActiveDocument.ClearSelection
Optimization = False
ActiveWindow.Refresh
MsgBox "G O T O W E"
End Sub

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Skrypt w X6 wygląda tak jak w załączniku, brak nadruku czarnego, zamiast C:0 M:0 Y:0 K:0 jest C:95 M:95 Y:45 K:95, więc to nie ten skrypt. Kolega pisze, że krzyżówkę w Corelu robi się w 10 min, przecież Corel nie układa krzyżówek.

Ten skrypt poniżej działa w X5, w X6 już nie, a ja właśnie potrzebuje na X6.
Sub zamien()
Dim kolor As Color
Optimization = True
For i = 1 To ActivePage.Shapes.Count
' zamiana wypełnienia na CMYK
If ActivePage.Shapes(i).Fill.UniformColor.Name = "Czarny" Then
ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 100)
ActivePage.Shapes(i).OverprintFill = True
ElseIf ActivePage.Shapes(i).Fill.UniformColor.Name = "Biały" Then
ActivePage.Shapes(i).Fill.ApplyUniformFill CreateCMYKColor(0, 0, 0, 0)
End If
' zamiana konturu na CMYK
If ActivePage.Shapes(i).Outline.Color.Name = "Czarny" Then
ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)
ActivePage.Shapes(i).OverprintOutline = True
ElseIf ActivePage.Shapes(i).Outline.Color.Name = "Biały" Then
ActivePage.Shapes(i).Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 0)
End If
' zamiana koloru fioletowych kratek
If ActivePage.Shapes(i).Fill.UniformColor.Type = cdrColorRGB And ActivePage.Shapes(i).Fill.UniformColor.Name = "unnamed color" Then
ActivePage.Shapes(i).Fill.UniformColor.ConvertToCMYK
End If
' podmiana "pustych" znaków na kropki
If ActivePage.Shapes(i).Type = cdrTextShape Then
If ActivePage.Shapes(i).Text.Story.Font = "Wingdings" Then
Dim pozx As Double
Dim pozy As Double
Dim rozmiar As Double
ActivePage.Shapes(i).GetPosition pozx, pozy
rozmiar = ActivePage.Shapes(i).Text.Story.size
ActivePage.Shapes(i).Delete
Dim tekst As Shape
Set tekst = ActiveLayer.CreateArtisticText(pozx, pozy, "ź", cdrPolish, , "Wingdings", rozmiar, cdrFalse, cdrFalse, cdrNoFontLine, cdrLeftAlignment)
End If
End If
Next
Optimization = False
ActiveWindow.Refresh
End Sub

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Załącznik

krz2.rar

Pobierz Plik ściągnięto 418 raz(y) 168.05 KB

chezare

Ja taką krzyżówkę ułożyłbym rozumem i narysował w Corelu, w 10 min :-)

Mój skrypt działa w 12 i działa w X3, jak jest wyżej nie wiem bo nie mam jak sprawdzić.
Skrypt, który zamieściłeś szuka kolorów białego i czarnego po nazwie. Nie zadziała w wersji angielskiej i być może z tego samego powodu nie działa w X6.
Sprawdź jak się nazywa, czy w ogóle się nazywa, kolor rgb 0/0/0 w Twojej krzyżówce?

Ten sprawdza kolory po wartościach a nie nazwach, sprawdź, może zadziała?

Sub To_CMYK()

Dim cf As New Color
Dim co As New Color
Dim s As Shape

Optimization = True

For Each s In ActiveSelection.Shapes
If s.Fill.Type = cdrUniformFill Then
cf.CopyAssign s.Fill.UniformColor
If cf.RGBRed = 0 And cf.RGBGreen = 0 And cf.RGBBlue = 0 Then
s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100
s.OverprintFill = True
ElseIf cf.RGBRed = 255 And cf.RGBGreen = 255 And cf.RGBBlue = 255 Then
s.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
Else
s.Fill.UniformColor.ConvertToCMYK
End If
End If
Next s

For Each s In ActiveSelection.Shapes
If s.Outline.Type = cdrOutline Then
co.CopyAssign s.Outline.Color
If co.RGBRed = 0 And co.RGBGreen = 0 And co.RGBBlue = 0 Then
s.Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100)
s.OverprintOutline = True
ElseIf co.RGBRed = 255 And co.RGBGreen = 255 And co.RGBBlue = 255 Then
s.Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 0)
End If
End If
Next s

Optimization = False
ActiveDocument.ClearSelection
ActiveWindow.Refresh

End Sub

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Niestety skrypt nie działa.

chezare

Zapomniałem napisać, że skrypt działa tylko w stosunku do zaznaczonych obiektów.
Trzeba najpierw wszystko zaznaczyć (ctrl+A).

bidon184

potwierdzam że skrypt działa w 100 procentach na x6

maroQ

chezare

Ja ten Support Team mam od samego początku. Sto razy pisałem, że się na tym nie znam, ale nikt nie słucha. :-)

Ja wiem co ten kod robi a kolega który ma kłopot z krzyżówkami w rgb nie wie, to po co mi albo jemu wcięcia? :-)

Dopóki wiem jak w VBA zrobić parasol, to będzie mi chyba trudno o mobilizację? :-)

Jak by mi się zdarzyło jednak kiedyś wyrwać z jakimś kodem to postaram się zrobić wcięcia, może nawet dodam komentarze :-)

Całkiem poważnie, to oczywiście masz Szaman rację, obsługa błędów nie zaszkodzi, choć jak Corel postanowi się wykopyrtnąć, to zrobi to nawet na

Kod:

on error

krnck · Bywalec Dołączył: 25 Mar 2010 Posty: 45 Skąd: Praga

Skrypt działa w X6.

chezare

Wiem że makro działa w X6, bo Bidon sprawdził :-)

Makro bada kolory po wartościach a nie nazwach, tak że powinno być odporne na różne wersje językowe, ale nie wszystko jest dobrze.
Poza obsługą błędów o której wspomniał kolega Szaman jest jeszcze inny problem.
Będzie dobrze jak wszystko jest w RGB, ale jak się trafi po drodze coś np. w CMYK, to kapota i to bez żadnego komunikatu o błędzie.

Edit
Poprawiłem, mam nadzieję że na lepsze :-)

Pozostał jeszcze problem kiedy w dokumencie przed uruchomieniem makra będzie czarny (0,0,0,100), wtedy nadrukowanie nie zostanie włączone i wszystkie te potencjalne kłopoty, które w tym momencie nie przychodzą mi do głowy :-)

Jedno jest pewne, jeśli w kodzie jest coś co może się wykoleić, to się wykolei.
Ja bym na wszelki wypadek robił kopie dokumentów :-)

Kod:

Sub RGB_to_CMYK()
' Procedura zamienia w zaznaczonych obiektach kolory rgb na cmyk
' RGB 0,0,0 zamienia na CMYK 0,0,0,100 i włącza nadrukowanie
' Wszystkie elementy w dokumencie zostaną rozgrupowane

Dim kw As New Color ' kolor wypełnienia
Dim kk As New Color ' kolor konturu
Dim s As Shape

' Jeśli nic nie zostało zaznaczone
If ActiveSelectionRange.Count = 0 Then
MsgBox "Trzeba zaznaczyć obiekty, których kolory mają zostać przekonwertowane!"
GoTo NIC
End If

Optimization = True ' wyłączenie odświeżania ekranu
On Error Resume Next ' jak by coś poszło nie tak :-)
ActiveSelection.UngroupAll

For Each s In ActiveSelection.Shapes ' ta konstrukcja działa w obrębie wszystkich
' zaznaczonych obiektów
If s.Fill.Type = cdrUniformFill Then ' sprawdzamy czy obiekt ma wypełnienie
kw.CopyAssign s.Fill.UniformColor ' jeśli ma to zapamiętujemy jego kolor
If kw.Type = cdrColorRGB Then ' interesuje nas tylko RGB
If kw.RGBRed = 0 And kw.RGBGreen = 0 And kw.RGBBlue = 0 Then
s.Fill.UniformColor.CMYKAssign 0, 0, 0, 100: s.OverprintFill = True
ElseIf kw.RGBRed = 255 And kw.RGBGreen = 255 And kw.RGBBlue = 255 Then
s.Fill.UniformColor.CMYKAssign 0, 0, 0, 0
Else: s.Fill.UniformColor.ConvertToCMYK
End If
End If
End If

' wypełnienie powinniśmy mieć załatwione
' w szczególny sposób traktowane są dwa kolory rgb: 0,0,0 i 255,255,255
' choć z białym raczej nie powinno być problemów?
' teraz te same manewry przeprowadzamy na konturze

If s.Outline.Type = cdrOutline Then ' to samo ale dla konturu
kk.CopyAssign s.Outline.Color ' jeśli jest to przyda nam się informacja
' o jego kolorze
If kk.Type = cdrColorRGB Then ' jeśli kolor konturu jest w RGB
If kk.RGBRed = 0 And kk.RGBGreen = 0 And kk.RGBBlue = 0 Then
s.Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 100): s.OverprintOutline = True
ElseIf kk.RGBRed = 255 And kk.RGBGreen = 255 And kk.RGBBlue = 255 Then
s.Outline.SetProperties Color:=CreateCMYKColor(0, 0, 0, 0)
Else: s.Outline.Color.ConvertToCMYK
End If
End If
End If
Next s

Optimization = False
ActiveDocument.ClearSelection
ActiveWindow.Refresh
NIC:
End Sub

Jak by ktoś łaskawie sprawdził czy to działa w X6, to byłbym wdzięczny :-)

Aha, nie biorę odpowiedzialności za ewentualne uszkodzenia zdrowia lub sprzętu.
Martwię się trochę, że może za mało wcięć zrobiłem, Szaman może być niezadowolony :-)

Przy okazji, Maro da się wstawić komentarz bez apostrofów przed każdym wierszem?

maroQ

chezare

Może myślników jest 5 rodzajów tak jak spacji? :-)

Dzięki serdeczne za łaskawą ocenę i za informacje o komentarzach, niestety jest tak jak myślałem.

tegraf

bidon184

ale sadzicie,Chezare napisal jakiś tam kod i działa co potwierdzam,a myślniki spacje,po grzyba to komuś,ja tam używam stopki czyli np _parent_parent itd a tego znaczku czyli - to chyba raz użyłem do ładowania pliku zewnetrznego,ale i tak muliło więc to olałem,dla mnie nie ma co kombinować,jak działa to działa i nie ma co się rozwijać,aczkolwiek dla bardziej ambitnych kodów pewnie ma to znaczenie :-)