Макрос не мой, но очень простой. рандомизирует шрифт и параметры шрифта в определенном диапазоне. Но он не работает в Excel.
Сам я в маркроса полный ноль вот прошу заставить его работать на Excel
Сам я в маркроса полный ноль вот прошу заставить его работать на Excel
| Код |
|---|
Sub RandomFont()
Application.ScreenUpdating = False
Set objDoc = ActiveDocument
Set objRandom = CreateObject("System.Random")
Set objRange = objDoc.Range()
Set colCharacters = objRange.Characters
For Each strCharacter In colCharacters
'strCharacter.Font.Reset
strCharacter.Font.Scaling = 100 + objRandom.Next_2(-50, 50) / 8 '??????? ?????? ??????
strCharacter.Font.Position = objRandom.Next_2(-200, 300) / 700 '??????? ??????? ???????????? ??????? ?????
strCharacter.Font.Size = strCharacter.Font.Size + objRandom.Next_2(-300, 400) / 400 '??????? ???????? ??????
strCharacter.Font.Kerning = 12 + objRandom.Next_2(-10, 40) / 5 '??????? ????????
Select Case objRandom.Next_2(1, 11) '????????? ?????
Case 1
strCharacter.Font.Name = "ZimM-1"
Case 2
strCharacter.Font.Name = "ZimM-2"
Case 3
strCharacter.Font.Name = "ZimM-3"
Case 4
strCharacter.Font.Name = "ZimM-4"
Case 5
strCharacter.Font.Name = "ZimM-5"
Case 6
strCharacter.Font.Name = "ZimM-6"
Case 7
strCharacter.Font.Name = "ZimM-7"
Case 8
strCharacter.Font.Name = "ZimM-8"
Case 9
strCharacter.Font.Name = "ZimM-9"
Case 10
strCharacter.Font.Name = "ZimM-10"
End Select
Next
Application.ScreenUpdating = True
End Sub
|
