Corel FORUM

[Trurl]

Potrzebuję makra, które ten sam jednowyrazowy napis, powiedzmy "Technologia" układałoby na stronie A4 w trzech kolumnach i jakichś 16 wierszach, zmieniając za każdym razem krój czcionki, zachowując tylko stopień pisma, powiedzmy 16 punktów, Chciałbym to zrobić wszystkimi fontami zainstalowanymi w systemie (ze 200 krojów). Chciałbym też, żeby pod każdym napisem pojawiała się nazwa użytego fontu, powiedzmy Arialem 8-punktowym.
Taki plik miałby kilkanaście stron, bo mam dużo fontów.
Choć używam Corela od jakichś 25 lat, iestety, nie potrafię pisać w nim makr, bo nie wiem, jak można się nauczyć języka programowania. To pewnie jakaś odmiana VB, ale nie ma do tego podręcznika. Proszę więc, żeby ktoś z Was napisał takie makro.

[Martin Nez]

Spróbuj użyć tego kodu:

Kod:

Dim a() As String Sub trurl()     Dim b As String     Dim c As Shape     Dim d, e, f, g, h As Integer     Dim i, j As Double         ActiveDocument.Unit = cdrMillimeter     ActiveDocument.ReferencePoint = cdrTopLeft     b = InputBox("Podaj napis:")     i = 10: j = ActivePage.SizeHeight - 10: h = 1     Optimization = True: bb     For d = 1 To UBound(a)         If Left(a(d), 1) = "@" Then h = h + 1     Next     For e = 1 To UBound(a) / 16 / 3         For f = 1 To 16             For g = 1 To 3                 Set c = ActiveLayer.CreateArtisticText(i, j, b, , , a(h), 16)                 Set c = ActiveLayer.CreateArtisticText(i, j - 5, a(h), , , "Arial", 8)                 i = i + 60: h = h + 1                 If h = Application.FontList.Count Then Exit Sub             Next             i = 10: j = j - 18         Next         ActiveDocument.AddPages 1: i = 10: j = ActivePage.SizeHeight - 10     Next     Optimization = False: Refresh End Sub Sub bb()     Dim b, c, d As Integer     Dim e As String     d = Application.FontList.Count     ReDim a(d)     For b = 1 To d         a(b) = Application.FontList.Item(b)     Next     For b = 1 To d - 1         For c = 0 To d - 1             If a(c) > a(c + 1) Then                 e = a(c): a(c) = a(c + 1): a(c + 1) = e             End If         Next     Next End Sub

Pozdr,
MN

[Trurl]

Dziękuję, ale coś chyba jest nie tak (niewykluczone, że ja ). Uruchamiam to makro z Makromenedżera, wpisuję słowo, które ma to makro obrabiać i widać, że coś liczy, ale, niestety, nie pojawia się żaden rezultat jego działalności.. Może to kwestia wersji Corela, którą mam? Mam Corela X5. A może źle je uruchamiam? Podpowiedz coś, proszę.

[Martin Nez]

Witam,
zakładam, że masz otwarty pusty dokument. Czy makro kończy działanie? U siebie mam ponad 800 fontów i trzeba odczekać 1-2 minuty zanim skończy tworzyć dokument. Spróbuj użyć poniższego kodu, żeby sprawdzić ile faktycznie fontów jest u Ciebie. Dla makra regular, bold, italic itp to oddzielne fonty.

Kod:

Sub ileFontow()      msbox(application.fontlist.count) End Sub

Możesz też spróbować zamienić linię:

Kod:

If h = Application.FontList.Count Then Exit Sub

na

Kod:

If h = 100 Then Exit Sub

Wtedy skrypt nie wygeneruje całego dokumentu, ale po 100 fontach zakończy działanie. Jeśli wszystko będzie ok to uruchom poprzedni kod i bądź cierpliwy. ;-)
Pozdr,
MN