[VBA] Changer la police de chaque lettre

Question

Bonjour, 

Pour une activité de centre aéré j'ai eu l'idée d'un petit programme, le but serait d'avoir un texte écrit avec pour chaque lettre une taille et une police différente (pour que ça fasse comme les messages anonymes écrits avec des lettres découpées dans les journaux et surtout pour essayer un peu la programmation).
Bref j'ai presque pas de connaissance la dedans, j'ai juste fait quelques macros très simple de sous Excel.

Mon idée c'était d'écrire le texte sous word, le copier dans la case A1 du tableur excel executer la macro et ensuite le recoller dans word. (bon si vous avez plus simple genre VBA sous word je suis ouvert mais je ne m'en suis jamais servi).

Donc j'ai essayé juste pour changer la police des lettres en aléatoire sur trois polices, mais je rajouterais des polices et des tailles si jamais j'arrive à le faire marcher.

Alors mes lignes c'est ça :

Sub changement_de_police()

Dim n As Long
    n = 1

Dim lettre As String
    lettre = Mid(A1, n)

Dim police As String

    Do While n <= Len(A1)
    
    x = Int(3 * Rnd)

    If x = 0 Then
    police = "Times New Roman"
    ElseIf x = 1 Then
    police = "Calibri"
    ElseIf x = 2 Then
    police = "Algerain"
    End If

    n = n + 1
    
    Dim lettre1 As Object
    lettre1 = lettre
        With lettre1
            With .Font.Name = police
              
            End With
        End With

Loop

End Sub

Mais ça ne marche pas, je pense que c'est au niveau de la lettre qui ne fonctionne pas en objet mais je ne sais pas comment contourner le problème, et il y a peut être d'autres soucis : comme vous le voyez je ne suis pas un as de la programmation.

Voila si quelqu'un à une petite idée pour me débloquer, ce serait super sympa.

Merci d'avance!

Configuration: Windows XP / Safari 534.30

pijaku · Answer

Salut,
Franchement, tu n'étais pas loin de la vérité...
Seule la fin était à changer : 
Dim lettre1 As Object 
lettre1 = lettre 
With lettre1 
With .Font.Name = police 
End With 
End WithJ'en ai profité également pour réorganiser ton code...
ça donne ceci :
Sub changement_de_police()
Dim police As String
Dim n As Long
Dim x As Byte

n = 1
Randomize
Do While n <= Len(ActiveCell)
    x = Int(3 * Rnd)
    If x = 0 Then
        police = "Times New Roman"
    ElseIf x = 1 Then
        police = "Calibri"
    ElseIf x = 2 Then
        police = "Algerian"
    End If
n = n + 1
With ActiveCell.Characters(n, 1)
    .Font.Name = police
End With
Loop
End Sub

[VBA] Changer la police de chaque lettre

1 réponse

Discussions similaires

Newsletters