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, 5) 'рандомный шрифт
        Case 1
          strCharacter.Font.Name = "Arial Black"
        Case 2
          strCharacter.Font.Name = "Times New Roman"
        Case 3
          strCharacter.Font.Name = "Calibri"
        Case 4
          strCharacter.Font.Name = "Arial"
      End Select
  Next
  
  Application.ScreenUpdating = True
End Sub