J'ai besoin d'ajouter du texte manuscrit au texte tapé dans MSWord. J'ai décidé d'utiliser une police d'écriture manuscrite mais le texte "manuscrit" n'a pas l'air vraiment manuscrit. J'imagine qu'en ajoutant un petit espacement aléatoire entre les caractères et en décalant vers le haut ou vers le bas les lettres tapées par la police d'écriture manuscrite, mon texte aurait l'air vraiment manuscrit. Est-il possible de le faire et comment ?
Réponse
Trop de publicités?
Andriy
Points
101
Ma solution
Sub start()
Dim v As Variant
Dim i As Integer
Dim d
Set d = CreateObject("Scripting.Dictionary")
d.Add 0, 12
d.Add 1, 12.5
d.Add 2, 13
d.Add 3, 13.5
d.Add 4, 14
Selection.Font.Name = "Segoe Print"
current_position = 0
current_sp = -1
With Selection
For Each Char In Selection.Characters
If Char <> " " Then
v = Int(Rnd * 50)
i = Int(Rnd * 5)
j = Int(Int(Rnd * 10) / 7) 'do we change char spacing or not
k = Int(Rnd) * 2 - 1
j1 = Int(Int(Rnd * 10) / 7) 'do we change char position or not
k1 = Int(Rnd) * 2 - 1
With Char.Font
.Scaling = 85 + v
.Spacing = -1
.Size = d.Item(i)
.Underline = False
.Color = RGB(30, 30, 30)
If IsNumeric(Char) = True Then
.Spacing = -2
End If
sp = 0
If current_sp = -1 Then
sp = k * j - 1
End If
If current_sp = 0 Then
sp = j - 1
End If
If current_sp = -2 Then
sp = -j - 1
End If
current_sp = sp
.Spacing = sp
pos = 0
If current_position = 0 Then
pos = k1 * j1
End If
If current_position = 1 Then
pos = j1
End If
If current_position = -1 Then
pos = -j1
End If
current_position = pos
.Position = pos
End With
End If
Next Char
End With
End Sub
