Dans un document assez long, vous avez besoin d'insérer de nombreuses images ou photos, et pour aller plus vite la solution serait d'insérer des balises qu'on remplacerait, une fois le document terminé, par les photos à l'aide de la macro suivante.
Vous allez commencer par mettre toutes vos images dans le même dossier et les numéroter de 1 à x. Exemple : Photo1.jpg, Photo2.jpg, etc.
Dans le document vous allez insérer des balises qui vont reprendre le nom de la photo, par exemple <Photo1>, <Photo2>, etc.
Une fois le document terminé, lancez la macro ci-dessous RemplacerBalisesParImages (que vous aurez mis auparavant dans un module de votre modèle ou du Normal.dotm).
Dans cette macro, j'ai donné à l'image un "texte alternatif" ( texte destiné aux non voyants) qui reprend le nom de la photo afin de faire éventuellement des vérifications.
Je précise que ces photos sont simplement liées pour éviter que le document soit trop lourd. Je précise également qu'il va s'agir de photos sans habillage. L'habillage générerait un grand bazar dans votre fichier !
On suppose également que les images sont pré-formatées concernant leur taille.
Il est toujours conseillé de travailler sur une copie, on ne sait jamais. Toutefois cette macro n'est pas définitive, car plus bas vous trouverez une macro qui fait l'inverse.
Dim doc As Document
Dim RepCourant As String
Dim i As Integer
Dim balise As String
Dim NomImage As String
Dim NomAffiche As String
' Spécifie le document en cours
Set doc = ActiveDocument
' Demande à l'utilisateur de choisir le dossier des images
With Application.FileDialog(msoFileDialogFolderPicker)
.Title = "Sélectionner le dossier des images"
.AllowMultiSelect = False
If .Show = -1 Then
RepCourant = .SelectedItems(1) & "\"
Else
Exit Sub
End If
End With
' Boucle pour remplacer les balises par les images
For i = 1 To 1000 ' Ajustez cette valeur en fonction du nombre maximum d'images
balise = "<Photo" & i & ">"
NomImage = RepCourant & "Photo" & i & ".jpg"
NomAffiche = "Photo" & i ' Nom sans extension
If Dir(NomImage) <> "" Then
Remplacer doc, balise, NomImage, NomAffiche
End If
Next i
MsgBox "Traitement terminé"
End Sub
Sub Remplacer(doc As Document, balise As String, NomImage As String, NomAffiche As String)
Dim rng As Range
Set rng = doc.Content
With rng.Find
.ClearFormatting
.Text = balise
.Replacement.Text = ""
.Forward = True
.Wrap = wdFindStop
.Format = False
.MatchCase = False
.MatchWholeWord = False
.MatchWildcards = False
.MatchSoundsLike = False
.MatchAllWordForms = False
Do While .Execute
If .Found Then
Set rng = rng.Duplicate
rng.Text = ""
rng.Collapse Direction:=wdCollapseStart
Dim shape As InlineShape
Set shape = rng.InlineShapes.AddPicture(FileName:=NomImage, LinkToFile:=True, SaveWithDocument:=False)
' Attendre que l'image soit correctement insérée
DoEvents
' Ajouter le nom de l'image comme texte alternatif pour qu'il apparaisse dans le volet de sélection
shape.AlternativeText = NomAffiche
shape.Title = NomAffiche ' Ajout du titre pour s'assurer que le nom est visible
rng.InsertAfter vbCrLf
rng.Collapse Direction:=wdCollapseEnd
End If
Loop
End With
End Sub
Voici, à présent, une macro qui fait l'inverse, à savoir qui retire les photos et les remplace par la balise.
Dim doc As Document
Dim shape As InlineShape
Dim AltText As String
Dim Balise As String
Dim i As Integer
' Spécifiez le document
Set doc = ActiveDocument
' Parcourir chaque image dans le document
For i = doc.InlineShapes.Count To 1 Step -1
Set shape = doc.InlineShapes(i)
' Vérifier si l'image est une image liée et a un texte alternatif
If shape.Type = wdInlineShapeLinkedPicture Then
AltText = shape.AlternativeText
If AltText <> "" Then
' Déterminer la balise en fonction du texte alternatif
Balise = "<" & AltText & ">"
' Remplacer l'image par la balise
shape.Range.Select
Selection.Text = Balise
End If
End If
Next i
MsgBox "Traitement terminé"
End Sub
