Recherche

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.

Sub RemplacerBalisesParImages()
    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.

Sub RemplacerImagesParBalises()
    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

Statistiques

France 75,6% France
Canada 8,1% Canada
États-Unis d'Amérique 4,8% États-Unis d'Amérique

Total:

65

Pays
018273687
Aujourd'hui: 10
Hier: 68
Cette semaine: 10
Semaine dernière: 783
Ce mois: 1.949