cjoint

Publicité


Publicité

Format du document : text/plain

Prévisualisation

Option Explicit
Sub RemplaceparImages()
Dim couleurs() As Variant
Dim liens() As Variant
Dim nbR() As String ' compteurs de remplacement
Dim nbM As Long ' nombre de mots du dosument
Dim doc As Document
Dim ic As Long
Dim im As Long
Dim r As Range
Dim ils As InlineShape
Dim hauteur As Single
Dim longueur As Single
Dim nbEsp As Long
Dim texte As String
' ADAPTER ICI ========================
' attention : respecter la casse
couleurs = Array("ROUGE", "VERT", "JAUNE")
liens = Array("D:\Icones\patins.ico", "D:\Icones\biere.ico", "D:\Icones\peche.ico")
hauteur = 12 ' fixe la hauteur des images.
longueur = 20.5
' ===================================
If UBound(couleurs) <> UBound(liens) Then
MsgBox "Les deux listes sont incohérentes"
End
End If
ReDim nbR(UBound(couleurs))
Set doc = ActiveDocument
'initialise les compteurs
For ic = 0 To UBound(nbR)
nbR(ic) = 0
Next ic
' balayage du document, mot par mot
nbM = doc.Words.count
For im = nbM To 1 Step -1
' balayage des couleurs
For ic = 0 To UBound(nbR)
'Debug.Print im, "'" & doc.Words(im).Text & "'"
If Trim(doc.Words(im).Text) = couleurs(ic) Then
nbEsp = Len(doc.Words(im).Text) - Len(Trim(doc.Words(im).Text))
Set r = doc.Words(im)
Set ils = doc.InlineShapes.AddPicture(FileName:=liens(ic), linktofile:=False, savewithdocument:=True, Range:=r)
' juste pour l'exemple
ils.Height = hauteur
ils.Width = longueur
' effacer le mot remplacé. Normalement il aurait du être remplacé par l'image.
' mais en word 2010 il reste, l'image est insérée avant.
Select Case nbEsp
Case 0
doc.Words(im + 1).Text = ""
Case 1
doc.Words(im + 1).Text = " "
Case 2
doc.Words(im + 1).Text = " "
Case Else
doc.Words(im + 1).Text = " "

End Select

nbR(ic) = nbR(ic) + 1
End If
Next ic
Next im
texte = ""
For ic = 0 To UBound(nbR)
Debug.Print couleurs(ic), nbR(ic)
texte = texte & couleurs(ic) & " : " & nbR(ic) & vbCrLf
Next ic

MsgBox texte
End Sub

Publicité


Signaler le contenu de ce document

Publicité