Corel FORUM

[michal.s]

Witam Panowie.
Czy moglibyście poratować mnie prostym kodem do zamiany włąściwości czcionki.
Mam tekst napisany Arialem o wielkości 10 pkt i chciałbym zamienić go na Vardenę o wielkości 15 pkt.
Jest to napewno mega proste ale... no właśnie zawsze jest to MAŁE ALE...

[Shame]

I potrzebujesz do tego makra? A nie możesz zrobić tego poleceniem EDYCJA > ZNAJDŹ I ZAMIEŃ > OBIEKT? No chyba, że masz 100 stron, to wtedy gorzej.









Ta opcja przeszukuje wszystkie teksty, nie ważne czy akapitowe, czy ozdobne, nieistotne, czy tylko fragment wyrazu/zdania, czy całe akapity. Jedyny jej mankament - działa w obrębie strony. JEDNAKŻE mając otwarte to ostatnie okienko możesz przejść na inną stronę, bo możesz operować w tle. Czyli Repalce all > klik na kolejną stronę > Replace all > klik na kolejna stronę i tak do końca.

[michal.s]

Witaj Shame.
Znam proponowaną przez Ciebie opcję i działa ona idealnie, ale...

Cytat:

ale... no właśnie zawsze jest to MAŁE ALE...

Opiszę Tobie szybciutko dlaczego w moim przypadku idealny byłby kod do zamiany właściwości czcionki.

Mam dziennie do przygotowania kilkanaście ramek z różnymi informacjami np. data, rozmiar, maszyna, grubości, wersje, kolory itd.
Przygotowałem sobie szablon i na warstwach umieściłem poszczególne elementy.
Na osobnej ramki, na innej teksty i osobną do wklejenia tekstów z bazy danych z OpenOffice.
Dane w OO mam przygotowane w jednym wierszu, każda informacja w osobnej komórce.
Kopiuję specjalnie do Corela na określoną warstwę.
Po skopiowaniu zaznaczam pierwszy tekst z OO i pierwszy tekst w Corelu wycentrowuję i tak powtarzam czynność kilkadziesiąt razy.
W między czasie zmieniam rodzaj i wielkość czcionki.
W nagrywanym makrze wygląda to super, ale okazuje się, że w momencie jak cokolwoek robię z czcionką to nagrany zostaje jakiś komunikat.
Potem usuwam warstwę z nieaktualnymi danymi i GOTOWE
Nagrywam z tego makro i wypełnienie ramki z kilkunastoma tekstami zajmuje mi... 5 sekund I love Corel
no właśnie... i tutaj pojawia się MOJE ALE...
Teksty mają różne wielkości i są umieszczone w różnej wielkości ramkach...
I właśnie do tego potrzebny mi jest wspomniany wyżej kod.

[chezare]

Michał, możesz to nagrane makro pokazać?

[michal.s]

Właśnie dopadłem kompa.
Zaraz wrzucę nagrane makro.

[michal.s]

Poniżej kod nagranego makra.
W miejsca kodu "' Recording of this command is not supported: TextEdit "
Chciałbym wstawić nazwę czcionki lub wielkość.
Tak samo makro działa idealnie... nie wygląda co prawda zbyt profesjonalnie (widzę jak potraficie ładnie rozpisywać kod) ale... no właśnie znów ale ale robi swoje

Kod:

Sub TemporaryMacro()     ' Recorded 2014-12-04     ActiveLayer.PasteSpecial "Enhanced Metafile"     Dim Paste1 As ShapeRange     Set Paste1 = ActiveSelectionRange     Paste1.Move 0#, -1.181102     Dim grp1 As ShapeRange     Set grp1 = Paste1.UngroupAllEx     'ZMIENIAM CZCIONKĘ NA VARDENA DLA WSZYSTKICH ZAZNACZONYCH ELEMENTÓW     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     'ZMIENIAM WSZYSTKIE ZAZNACZONE ELEMENTY NA ROZMIAR CZCIONKI 10pkt.     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     'ZMIENIAM KOLOR DLA WSZYSTKICH ZAZNACZONYCH ELEMENTÓW NA     grp1.ApplyUniformFill CreateRGBColor(0, 69, 134)     grp1(1).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(1), cdrTextAlignBoundingBox     grp1(3).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(2), cdrTextAlignBoundingBox     grp1(9).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(3), cdrTextAlignBoundingBox     grp1(11).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(5), cdrTextAlignBoundingBox     'ZMIANA WIELKOŚCO CZCIONKI NA 6pkt     ' Recording of this command is not supported: TextEdit         grp1(10).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(4), cdrTextAlignBoundingBox         'ZMIANA WIELKOŚCO CZCIONKI NA 7pkt         ' Recording of this command is not supported: TextEdit         grp1(33).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(9), cdrTextAlignBoundingBox     'ZMIANA WIELKOŚCO CZCIONKI NA 3,6pkt     ' Recording of this command is not supported: TextEdit         grp1(34).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(10), cdrTextAlignBoundingBox     'ZMIANA WIELKOŚCO CZCIONKI NA 9pkt     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit     ' Recording of this command is not supported: TextEdit         grp1(2).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(14), cdrTextAlignBoundingBox     grp1(8).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(8), cdrTextAlignBoundingBox     grp1(12).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(6), cdrTextAlignBoundingBox     grp1(13).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(7), cdrTextAlignBoundingBox     grp1(18).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(15), cdrTextAlignBoundingBox     grp1(16).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(13), cdrTextAlignBoundingBox     grp1(17).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(16), cdrTextAlignBoundingBox     grp1(14).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(11), cdrTextAlignBoundingBox     grp1(15).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(12), cdrTextAlignBoundingBox     ActiveDocument.CreateShapeRangeFromArray(ActivePage.Layers("teksty_do podmiany").Shapes(19), grp1(4)).Distribute cdrDistributeLeft + cdrDistributeRight, False     grp1(4).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(19), cdrTextAlignBoundingBox     grp1(5).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(25), cdrTextAlignBoundingBox     grp1(6).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(28), cdrTextAlignBoundingBox     grp1(7).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(34), cdrTextAlignBoundingBox     grp1(31).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(22), cdrTextAlignBoundingBox     grp1(32).AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(31), cdrTextAlignBoundingBox     grp1(30).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(32), cdrTextAlignBoundingBox     grp1(29).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(29), cdrTextAlignBoundingBox     grp1(28).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(26), cdrTextAlignBoundingBox     grp1(27).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(23), cdrTextAlignBoundingBox     grp1(26).AlignToShape cdrAlignLeft + cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(20), cdrTextAlignBoundingBox     Set s1 = grp1(3).Duplicate     Paste2.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(18), cdrTextAlignBoundingBox     Dim dup3 As ShapeRange     Set dup3 = Paste2.Duplicate     dup3.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(21), cdrTextAlignBoundingBox     Dim dup4 As ShapeRange     Set dup4 = dup3.Duplicate     dup4.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(24), cdrTextAlignBoundingBox     Dim dup5 As ShapeRange     Set dup5 = dup4.Duplicate     dup5.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(27), cdrTextAlignBoundingBox     Dim dup6 As ShapeRange     Set dup6 = dup5.Duplicate     dup6.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(30), cdrTextAlignBoundingBox     Dim dup7 As ShapeRange     Set dup7 = dup6.Duplicate     dup7.AlignToShape cdrAlignLeft + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(33), cdrTextAlignBoundingBox     grp1(19).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(18), cdrTextAlignBoundingBox     grp1(20).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(21), cdrTextAlignBoundingBox     grp1(21).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(24), cdrTextAlignBoundingBox     grp1(22).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(27), cdrTextAlignBoundingBox     grp1(23).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(30), cdrTextAlignBoundingBox     grp1(24).AlignToShape cdrAlignRight + cdrAlignTop + cdrAlignBottom, ActivePage.Layers("teksty_do podmiany").Shapes(33), cdrTextAlignBoundingBox     ActivePage.Layers("teksty_do podmiany").Shapes.All.CreateSelection     ActiveSelection.Delete     ActivePage.Layers("teksty_do podmiany").Activate End Sub

[chezare]

Normalnie, tam gdzie się coś dzieje, to Corel nie potrafi tego przetłumaczyć na kod VBA.
Żeby się zabrać za napisanie takiego makra, to trzeba wiedzieć parę rzeczy, czy mają być zmieniane wszystkie teksty, tylko zaznaczone, a może tylko fragmenty akapitów?
Czy to jest tekst ozdobny, akapitowy, a może i taki i taki?
Czy zawsze jest szukana jedna i ta sama czcionka, czy wielkość jest zawsze taka sama, pewnie nie? To wcale nie jest takie banalne zadanie, bo przecież bez sensu byłoby gdybyś te parametry musiał zmieniać w makrze.

[michal.s]

chezare

Cytat:

Żeby się zabrać za napisanie takiego makra, to trzeba wiedzieć parę rzeczy, czy mają być zmieniane wszystkie teksty, tylko zaznaczone, a może tylko fragmenty akapitów?

za każdym razem zmiana odnosi się do zaznaczonych elementów.

Cytat:

Czy to jest tekst ozdobny, akapitowy, a może i taki i taki?

Są to za każdym razem teksty ozdobne.

Cytat:

Czy zawsze jest szukana jedna i ta sama czcionka, czy wielkość jest zawsze taka sama, pewnie nie?

tak jak pisałem wyżej zmiana dotyczy aktualnie zaznaczonych tekstów

Nabyłem drogą kupna książkę "Automatyzacja Corel Draw skrypty" i znalazłem coś takiego
.SetCharakterAttributes 0, 10, "Arial", 13, 900, 0, 0, 0, 0, 0, 0, 0, 1
Myślę, że można by to zastosować z drobną korektą w miejsce kodu
' Recording of this command is not supported: TextEdit
Niestety nie potrafię sam tego wykonać stąd moja prośba

[chezare]

Ta procedura powinna zmienić font we wszystkich zaznaczonych tekstach artystycznych na Verdanę, 15 pkt.

Kod:

Sub zmiana_fontu() Dim sr As ShapeRange Dim sh As Shape Set sr = ActiveSelectionRange For Each sh In sr     If sh.Text.IsArtisticText Then         sh.Text.Story.Font = "Verdana"         sh.Text.Story.Size = 15     End If Next sh End Sub

Albo z jakąś możliwością wyboru

Kod:

Sub zmiana_fontu2() Dim sr As ShapeRange Dim sh As Shape Dim te As Text Dim fo As String Dim ro As Integer Dim i As Integer Set sr = ActiveSelectionRange i = InputBox("1-Verdana, 15 pkt" & Chr(13) & "2-Verdana, 20 pkt" & Chr(13) & _ "3-Arial, 14 pkt" & Chr(13) & "4-Tahoma, 16 pkt", "wybierz", 1) Select Case i Case 1     fo = "Verdana"     ro = 15 Case 2     fo = "Verdana"     ro = 20 Case 3     fo = "Arial"     ro = 14 Case 4     fo = "Tahoma"     ro = 16 Case Else     fo = "Verdana"     ro = 10 End Select For Each sh In sr     If sh.Text.IsArtisticText Then         Set te = sh.Text         te.Story.Font = fo         te.Story.Size = ro     End If Next sh End Sub

[tomek123]

Procedura zmieniająca czcionkę w zaznaczonym obszarze, co jest dość przydatne... dodatkowo nie ignoruje zgrupowanych obiektów.

Kod:

Sub Zmiana_Czcionki()     Dim v_fonts(), fontNr As Integer, fontName As String, i As Integer, quest As String     v_fonts = Array("Tahoma", "Arial", "Times New Roman") ' <--tutaj mozna dopisac dowolne zainstalowane czcionki     For i = LBound(v_fonts) To UBound(v_fonts)         quest = quest & i & "." & v_fonts(i) & vbCr     Next i     fontNr = InputBox("Podaj nr czcionki:" & vbCr & quest, "Zmiana czcionki", 0)     fontName = v_fonts(fontNr)     Replace_Font fontName End Sub Function Replace_Font(fontName As String)     Dim s As Shape, sr As ShapeRange, fontSize As Double     Set sr = ActiveSelectionRange     For Each s In ActiveSelectionRange.Shapes.FindShapes(, cdrTextShape, True)             s.text.Story.font = fontName             s.CreateSelection             fontSize = InputBox("Podaj wielkosc czcionki:", "Rozmiar czcionki", s.text.Story.Size)             s.text.Story.Size = fontSize     Next s     sr.CreateSelection End Function