Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.12.2012, 09:12   #11
phucker
Новичок
Джуниор
 
Регистрация: 13.12.2012
Сообщений: 2
По умолчанию

Цитата:
Сообщение от sguschenka Посмотреть сообщение
Sub Макрос2()

For k = 1 To 300

'Блок генерации случайных параметров
S = 7 * Rnd + 16 'Размер шрифта от 16 до 23
L = 5 * Rnd + 1 'Длина выделяемого блока от 1 до 6 символов
P = 2 * (Rnd - 0.5) * 2 'Вертикальное отклонение от -2 до +2
D = 2 * (Rnd - 0.5) * 3 'Разрыв между символами от -3 до +3
.....
Узнаю свой макрос. Я его в своё время сделал для MS Word 2003.

Как показала практика, у людей возникали проблемы с настройкой макроса. Поэтому недавно я создал онлайн версию этой программы на javascript.

ManuScript. Имитация рукописного текста онлайн

http://anuscript.narod.ru/

С помощью онлайн-программы ManuScript Вы можете имитировать рукописные документы из любых исходных текстов. Для достижения наилучшего эффекта рукописи, рекомендую установить в системе дополнительные рукописные шрифты. Попробуйте воспользоваться рукописными шрифтами из архива.



При обработке текстов большого объёма программа может заметно притормаживать.

Скрины работы:
http://s2.ipicture.ru/uploads/20121212/qWBu25y6.jpg
http://s3.uploads.ru/q9WRl.gif

Последний раз редактировалось phucker; 13.12.2012 в 09:16.
phucker вне форума Ответить с цитированием
Старый 14.12.2012, 16:03   #12
phucker
Новичок
Джуниор
 
Регистрация: 13.12.2012
Сообщений: 2
По умолчанию

Важной отличительной особенностью новой программы на javascript является возможность использования двух или более разных шрифтов для имитации рукописного текста (рукописи). Согласитесь, что такой подход позволяет достичь большей свободы в рандомизации написания текста. В принципе, пользователь может сгенерировать под свой почерк два-три шрифта с небольшими отклонениями в написании одних и тех же букв. А после с помощью программы ManuScript создать на их основе живой рукописный текст.
phucker вне форума Ответить с цитированием
Старый 03.03.2018, 22:39   #13
rublan
Новичок
Джуниор
 
Регистрация: 03.03.2018
Сообщений: 1
По умолчанию

Немного доработал макрос. Теперь он перебирает шрифты. В связи с тем, что шрифты разные, отступ слева тоже отличается в каждой строчке. Плюс добавил возможность указывать количество обрабатываемых символов. Спасибо sguschenka за исходный код макроса!

Sub РукописныйШрифт()

Dim R As Single, Temp As String
Temp = InputBox("Введите количество обрабатываемых символов", "Ввод данных")
If Temp <> "" Then
R = CSng(Temp)


For k = 1 To R

'Блок генерации случайных параметров
S = 1.5 * (Rnd) + 21 'Размер шрифта от 21 до 22
L = 1 'Длина выделяемого блока 1 символов
P = 1.5 * (Rnd - 0.5) 'Вертикальное отклонение от -0,75 до +0,75
D = 0.5 + (Rnd) 'Разрыв между символами от 0,5 до +1,5

' Выделение символьного фрагмента
Selection.MoveRight Unit:=wdCharacter, Count:=L, Extend:=wdExtend

' Установка параметров текста
With Selection.Font
.Name = Array("E1", "E2", "E3", "E4")(CInt(Rnd * 3)) ' <---- Рукописный шрифт
.Size = S
.Bold = False
.Italic = False
.Underline = wdUnderlineNone
.UnderlineColor = wdColorAutomatic
.StrikeThrough = False
.DoubleStrikeThrough = False
.Outline = False
.Emboss = False
.Shadow = False
.Hidden = False
.SmallCaps = False
.AllCaps = False
.Color = 0
.Engrave = False
.Superscript = False
.Subscript = False
.Spacing = D
.Scaling = 100
.Position = P
.Kerning = 0
.Animation = wdAnimationNone
End With
Selection.MoveRight Unit:=wdCharacter, Count:=1

Next k

MsgBox "Шрифт применён. Обработано " & R & " символов.", , "Результат обработки"

Else: MsgBox "Вы отказались от ввода данных! Макрос не применён."
End If
End Sub
rublan вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Не работает рукописный ввод vlad911 Microsoft Office Word 7 25.04.2013 17:29
Текст стандартных функций и процедур для работы со строками в Delphi Pixma Помощь студентам 3 17.11.2010 13:25
Рукописный компонент-кнопка NoName_emaNoN Компоненты Delphi 0 24.05.2010 20:06
Нужен помощник для сдачи экзамена gx5rmsu8x Помощь студентам 0 30.01.2010 18:05
Для облегчения работы с TFS - приложение для работы над дефектами и задачами Аякс Софт 1 18.03.2009 11:43