Insertion et generation photos+legendes

J'ai fait un programme il y a quelques temps:

https://codes-sources.commentcamarche.net/source/53718-planche-contact-sous-word

Voir sur ce site un plus récent:

http://www.cjoint.com/data3/3ArrZpvb3K9.htm

Nouveau lien, ne pas tenir compte du précédent

http://www.cjoint.com/data3/3Arseu9i6GY.htm

Bonjour

Merci mais cela ne correspond pas vraiment à ce que je recherche...

J'ai bien progressé mais là je bloque au 3/4 de la macro ci-dessous :

Sub AutoNew()
 '
 'InsertionImageLégende Macro
 'Permet l'insertion d'une image avec une légende automatique et groupée
 '

 'Sélectionnons notre image
Selection.EndKey Unit:=wdStory
 Dim pict As Shape
 Dim path As Variant
 Dim test As Integer
 With Application.FileDialog(msoFileDialogOpen)
    .AllowMultiSelect = True
    .Filters.Clear
    .Filters.Add "Toutes les images (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg)", "*.emf; *.wmf; *.jpg; *.jpeg; *.jfif; *.jpe; *.png; *.bmp; *.dib; *.rle; *.gif; *.emz; *.wmz; *.pcz; *.tif; *.tiff; *.cgm; *.eps; *.pct; *.pict; *.wpg", 1
    .Show
    
       For test = .SelectedItems.Count To 1 Step -1
       path = .SelectedItems(test)
       
       'Insérons notre image
       Set pict = ActiveDocument.Shapes.AddPicture(path)
       pict.Select
       pict.ZOrder msoBringInFrontOfText 'Mise en forme devant le texte pour le groupage
       'Alignement par rapport au paragraphe dans lequel le curseur clignote
       'pict.Top = 0
       'pict.Left = 0
       'Recherche du nom de l'image : on prend la chaîne de caractères située après le dernier "\"
       Dim name As String
       Dim i As Integer
       i = Len(path)
       Do While Not (Mid(path, i, 1) = "\") And i > 0
       i = i - 1
       Loop
       path = Mid(path, i + 1, Len(path) - i)
       'Le nom trouvé est mis dans la zone de texte en tant que légende
       Selection.InsertCaption Label:=" ", Title:=" " '<== Débogage ICI
       Dim LastShape As Integer
       LastShape = ActiveDocument.Shapes.Count
       ActiveDocument.Shapes(LastShape).Select
       'Texte centré
       Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
       'Groupage de l'image et de la zone de texte
       pict.name = path
       ActiveDocument.Shapes(LastShape).name = "caption : " + path
       ActiveDocument.Shapes.Range(Array(path, "caption : " + path)).Group.ConvertToInlineShape
       Next
 End With
 
 
 End Sub

arrivé à la ligne signalée message "débogage"
Je suis perdue

pouvez vous m'aider ?
a bientôt j'espère
Cats310

Je t'ai transmis ces liens pour que tu puisses les étudier. Dedans tu trouveras une macro pour ajouter un titre à ton image, a toi de l'adapter:

 'ajouter nom du fichier
Sub ajout_text()
fichiersansext = Left(fichierseul, Len(fichierseul) - 4)
 CaptionLabels.Add Name:="Image" 'choisissez le nom que vous désirez
ActiveDocument.InlineShapes(image).Range.InsertCaption _
    Label:="Image", _
    Title:=": " & fichiersansext, Position:=wdCaptionPositionAbove ', ExcludeLabel:=1 'supprime le label reste numero
End Sub

Bonsoir

Merci pour ta rapidité ...mais cela ne m'aide pas beaucoup

La macro transmise précédemment fonctionnait trés bien avant seulement je ne sais pas où est le bug aujourd'hui

Voici le code corrigé:

Sub insertimage()
'InsertionImageLégende Macro
 'Permet l'insertion d'une image avec une légende automatique et groupée
 Dim name As String
 Dim i As Integer
 Dim LastShape As Integer
 Dim posit, fichierseul

 'Sélectionnons notre image
Selection.EndKey Unit:=wdStory
 Dim pict As Shape
 Dim path As Variant
 Dim test As Integer
 With Application.FileDialog(msoFileDialogOpen)
 .AllowMultiSelect = True
 .Filters.Clear
 .Filters.Add "Toutes les images (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg)", "*.emf; *.wmf; *.jpg; *.jpeg; *.jfif; *.jpe; *.png; *.bmp; *.dib; *.rle; *.gif; *.emz; *.wmz; *.pcz; *.tif; *.tiff; *.cgm; *.eps; *.pct; *.pict; *.wpg", 1
 .Show
 For test = .SelectedItems.Count To 1 Step -1
 path = .SelectedItems(test)
     'Recherche du nom de l'image : on prend la chaîne de caractères située après le dernier "\"
       Do
        posit = InStr(1, path, "\")
        path = Right(path, Len(path) - posit)
                Loop Until posit = 0
    fichierseul = path
 'Insérons notre image
 Set pict = ActiveDocument.Shapes.AddPicture(path)
 pict.Select
 pict.ZOrder msoBringInFrontOfText 'Mise en forme devant le texte pour le groupage
 'Alignement par rapport au paragraphe dans lequel le curseur clignote
 pict.Top = 20 'on descend l'image
 pict.Left = 0
 'nom sans l'extension
 name = Left(fichierseul, Len(fichierseul) - 4)
'Le nom trouvé est mis dans la zone de texte en tant que légende
Selection.Collapse Direction:=wdCollapseStart
Selection.InsertCaption Label:="Image", _
Title:=": " & name, Position:=wdCaptionPositionAbove
 LastShape = ActiveDocument.Shapes.Count
 ActiveDocument.Shapes(LastShape).Select
 'Texte centré
 Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
 'Groupage de l'image et de la zone de texte
 pict.name = path
 ActiveDocument.Shapes(LastShape).name = "caption : " + path
 'ActiveDocument.Shapes.Range(Array(path, "caption : " + path)).Group.ConvertToInlineShape
 Next
 End With
End Sub

Un petit conseil, tu sélectionnes : InsertCaption et tu appuies sur F1, tu auras ton code

Une autre manière de procéder avec la légende sous l'image au quelle on a ajouté la date courante.:

Sub insertimage()
 'Permet l'insertion d'une image avec une légende automatique et groupée
 Dim name As String
 Dim i As Integer
 Dim posit, fichierseul
 Dim path As Variant
 Dim test As Integer
 With Application.FileDialog(msoFileDialogOpen)
 .AllowMultiSelect = True
 .Filters.Clear
 .Filters.Add "Toutes les images (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg)", "*.emf; *.wmf; *.jpg; *.jpeg; *.jfif; *.jpe; *.png; *.bmp; *.dib; *.rle; *.gif; *.emz; *.wmz; *.pcz; *.tif; *.tiff; *.cgm; *.eps; *.pct; *.pict; *.wpg", 1
 .Show
 For test = .SelectedItems.Count To 1 Step -1
  path = .SelectedItems(test)
  Next
 End With
 If path = "" Then Exit Sub' si annulation
  'Insérons notre image
 Selection.InlineShapes.AddPicture FileName:=path, LinkToFile:=False, SaveWithDocument:=True
 i = ActiveDocument.InlineShapes.Count 'nbre d'images
 'redimensionnement des images a activer si necessaire
'With ActiveDocument.InlineShapes(i)
  '  .ScaleHeight = 30
  '  .ScaleWidth = 30
'End With
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter 'centrer l'image
Selection.ClearFormatting
'Recherche du nom de l'image : on prend la chaîne de caractères située après le dernier "\"
       Do
        posit = InStr(1, path, "\")
        path = Right(path, Len(path) - posit)
                Loop Until posit = 0
    fichierseul = path
     'nom sans l'extension
 name = Left(fichierseul, Len(fichierseul) - 4)
'Le nom trouvé est mis dans la zone de texte en tant que légende
Selection.Collapse Direction:=wdCollapseStart
Selection.InsertCaption Label:="Image", _
Title:=": " & name & "-", Position:=wdCaptionPositionAbove
InsertDateTimeMethod
End Sub
'http://support.microsoft.com/kb/212682/fr
Sub InsertDateTimeMethod()
   Dim MyRange As Object
   Set MyRange = Selection.Range
   MyRange.InsertDateTime DateTimeFormat:="dd MMM yyyy", _
   InsertAsField:=True
 End Sub

Voir le lien pour les ajouts de texte

Bonjour

Merci pour les infos :

de mon coté

Sub AutoNew()
'
'InsertionImageLégende Macro
'Permet l'insertion d'une image avec une légende automatique et groupée
'

'Sélectionnons notre image
Selection.EndKey Unit:=wdStory
Dim pict As Shape
Dim path As Variant
Dim test As Integer
With Application.FileDialog(msoFileDialogOpen)
.AllowMultiSelect = True
.Filters.Clear
.Filters.Add "Toutes les images (*.emf;*.wmf;*.jpg;*.jpeg;*.jfif;*.jpe;*.png;*.bmp;*.dib;*.rle;*.gif;*.emz;*.wmz;*.pcz;*.tif;*.tiff;*.cgm;*.eps;*.pct;*.pict;*.wpg)", "*.emf; *.wmf; *.jpg; *.jpeg; *.jfif; *.jpe; *.png; *.bmp; *.dib; *.rle; *.gif; *.emz; *.wmz; *.pcz; *.tif; *.tiff; *.cgm; *.eps; *.pct; *.pict; *.wpg", 1
.Show

For test = .SelectedItems.Count To 1 Step -1
path = .SelectedItems(test)

'Insérons notre image
Set pict = ActiveDocument.Shapes.AddPicture(path)
pict.Select
pict.ZOrder msoBringInFrontOfText 'Mise en forme devant le texte pour le groupage
'Alignement par rapport au paragraphe dans lequel le curseur clignote
'pict.Top = 0
'pict.Left = 0
'Recherche du nom de l'image : on prend la chaîne de caractères située après le dernier "\"
Dim name As String
Dim i As Integer
i = Len(path)
Do While Not (Mid(path, i, 1) = "\") And i > 0
i = i - 1
Loop
path = Mid(path, i + 1, Len(path) - i)
'Le nom trouvé est mis dans la zone de texte en tant que légende
With CaptionLabels("image")
.NumberStyle = wdCaptionNumberStyleArabic
.IncludeChapterNumber = False
End With
Selection.InsertCaption Label:="image", TitleAutoText:= _
"InsertionLégende10", Title:="", Position:=wdCaptionPositionBelow, _
ExcludeLabel:=1
Dim LastShape As Integer
LastShape = ActiveDocument.Shapes.Count
ActiveDocument.Shapes(LastShape).Select
'Texte centré
Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'Groupage de l'image et de la zone de texte
pict.name = path
ActiveDocument.Shapes(LastShape).name = "caption : " + path
ActiveDocument.Shapes.Range(Array(path, "caption : " + path)).Group.ConvertToInlineShape
Next
End With

End Sub

cette macro fonctionne super bien sur word 2013 (maison) mais pas sur word 2010 (bureau)... grrrrrr....why

besoin urgent au bureau en fait donc word 2010
merci de votre aide

Je suis avec Word 2007, donc de ce côté là, je ne peux pas faire d'essai.

Tu peux essayer de les enregistrer sous Word 97-2003

As-tu essayé les 2 procédures que je t'ai donné ?

je les ai tentées sur word 2013 mais elles ne fonctionnent pas, je ne pourrai les tester que demain sur 2010....

à défaut comment faut-il faire pour enregistrer celle qui fonctionne sur 2013 en format 97-2003 seulement en cochant la case mode de compatibilité avec versions précédentes ??

Pour enregistrer

Cliquez sur le logo en haut à gauche

Enregistrer sous

Document Word 97-2003

merci je tente demain, au bureau et vous tiens au courant
bonsoir

Chez moi sous Word 2007, j'ai une erreur ici:

Selection.InsertCaption Label:="image", TitleAutoText:= _ 
 "InsertionLégende10", Title:="", Position:=wdCaptionPositionBelow, _ 
 ExcludeLabel:=1 

d'autre part tu recherches la variable name, mais tu ne l'utilises pas