1 Тема от Greymr

  • Greymr
  • рядовой
  • Неактивен
  • Зарегистрирован: 25.02.2011
  • Сообщений: 3

Тема: Прошу помощи, нужен скрипт для цикличной смены шрифтов.

Доброго времени суток. Решил обратится на ваш форум с таким вопросом -
создал для себя рукописные шрифты, если писать одним шрифтом, естественно все буквы будут под одну гребенку, поэтому сделал несколько шрифтов. Но как сделать так, чтобы выбранные мною шрифты сами циклично менялись, когда я печатаю текст в Word-е, чтобы буквы получались разными шрифтами ?
Может есть такой скрипт, или его можно сделать ?
Прошу Вашей помощи в этом деле.

2 Ответ от Greymr

  • Greymr
  • рядовой
  • Неактивен
  • Зарегистрирован: 25.02.2011
  • Сообщений: 3

Re: Прошу помощи, нужен скрипт для цикличной смены шрифтов.

Готов материально поддержать создателя (единовременно smile) ибо всякий труд должен быть вознагражден.
в разумных пределах smile

3 Ответ от Вождь

  • Прошу помощи, нужен скрипт для цикличной смены шрифтов.
  • Вождь
  • Модератор
  • Неактивен
  • Зарегистрирован: 07.01.2010
  • Сообщений: 745
  • Поблагодарили: 181

Re: Прошу помощи, нужен скрипт для цикличной смены шрифтов.

Думаю, более удобен будет макрос, раскидывающий шрифты по уже набранному тексту. Т.е. макрос меняющий шрифт каждого символа (или слова) на один из случайных шрифтов из набора рукописных. Можно будет любой документ конвертировать в "рукописный".

Или важно именно изменение по ходу набора, для контроля результата?

Макросы под заказ и готовый пакет - mtdmacro.ru

СайтВождь

4 Ответ от Greymr

  • Greymr
  • рядовой
  • Неактивен
  • Зарегистрирован: 25.02.2011
  • Сообщений: 3

Re: Прошу помощи, нужен скрипт для цикличной смены шрифтов.

Спасибо за подсказку, будем смотреть.  Не подскажете, нашел вот такой вот макрос -
Sub МенялкаСлов()
Dim w As Range
For Each w In ActiveDocument.Range.Words
DoEvents
w.Font.Color = RGB(Rnd * 255, Rnd * 255, Rnd * 255)
w.Font.Size = 8 + CInt(Rnd * 8)
w.Font.Name = Array("Times New Roman", "Arial Black", "Batang", "Century")(CInt(Rnd * 3))
Next w
End Sub

Он меняет шрифт, цвет и размер -  но слов. А можно ли сделать из него макрос меняющий только шрифты ?, и применительно не к слову а к каждой букве ?.   

"Или важно именно изменение по ходу набора, для контроля результата?"

не столь важно, но это конечно был бы предел мечтаний, но такой скрипт наверное сложно будет сделать ? может кто нибудь сможет его сделать под заказ ? цена вопроса ?

С уважением, Greymr

5 Ответ от Вождь

  • Прошу помощи, нужен скрипт для цикличной смены шрифтов.
  • Вождь
  • Модератор
  • Неактивен
  • Зарегистрирован: 07.01.2010
  • Сообщений: 745
  • Поблагодарили: 181

Re: Прошу помощи, нужен скрипт для цикличной смены шрифтов.

Greymr пишет:

макрос меняющий...шрифты...каждой букве

Sub Шрифтовой_Миксер()

Dim C As Range
Dim A As Variant
Dim N1&, N2&

    A = Array("Шрифт 1", "Шрифт 2", "Шрифт 3")
    N1 = LBound(A)
    N2 = UBound(A) - LBound(A) + 1
    For Each C In ActiveDocument.Range.Characters
        Randomize
        C.Font.Name = A(N1 + Int(N2 * Rnd))
    Next C
    
End Sub
Greymr пишет:

цена вопроса

Обзаведетесь моим пакетом макросов, бесплатно сделаю переключение при наборе.

Макросы под заказ и готовый пакет - mtdmacro.ru

СайтВождь