Discussion :

[dadoo99]

Bonjour à tous,

J'ai lu plusieurs articles, mais ne trouve pas la solution à mon problème. Comme beaucoup d'utilisateurs, je dois insérer de nombreuses photos dans un fichier Word. Et voici ce que j'aimerais faire :
1. Insérer un tableau à l'endroit où se trouve le curseur
Deux colonnes : largeurs de 9 cm
Trois lignes : Hauteurs fixes : 1ère ligne 5 cm de haut, 2ème ligne 0.5 cm de haut, 3ème ligne 0.1 cm de haut
Bordures : visible pour les deux premières lignes et non visible pour la troisième ligne
Alignement du tableau : centré
Alignement à l'intérieur du tableau : centré
2. Insérer toutes les photos contenus dans un certain dossier que je choisis à chaque activation de la macro
Première ligne : insertion d'une photo par colonnes
Deuxième ligne : insertion du nom des photos sans l'extension
Troisième ligne : rien
3. Puis s'il y a plus de 2 photos dans le dossiers
Créer trois lignes supplémentaires selon les indication du point 1
Insérer les photos suivantes et noms de photos selon les indications du point 2
4. Répétez l'opération jusqu'à ce que toutes les photos et noms de photos aient été insérés

J'ai déjà un bout de code créé par un utilisateur nommé JP et quelque peu modifié par mes soins, mais qui ne fait pas exactement cela. Notamment le code insère les photos dans un tableau dimensionné pré-existant. Le voici :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
Sub InsertionImages()
' J.P Octobre 2016
Dim Repertoire As String
Dim Extension As String
Dim Fichier As String
Dim intResult As Integer
Dim strPath As String
Dim MonTableau As Table
' on prend le premier tableau du document
Set MonTableau = ActiveDocument.Tables(1)
'La fenêtre de choix de répertoire est affichée
intResult = Application.FileDialog(msoFileDialogFolderPicker).Show
'On sort si le choix du répertoire a été annulé
If intResult = 0 Then Exit Sub
 Repertoire = Application.FileDialog(msoFileDialogFolderPicker).SelectedItems(1) & "\"
'Saisie du type d'extension
Extension = InputBox("Type de fichier (sans le point, ex : jpg, png, bmp)", "Type de fichier", "jpg")
'Récupération du premier fichier du répertoire
Fichier = Dir(Repertoire & "*" & Extension, vbDirectory)
Do While Fichier <> ""
    InsérerImage MonTableau, Repertoire & Fichier
    'Récupération du prochain fichier du répertoire
    Fichier = Dir
Loop
End Sub
 
 Function CréerNewLgTableau(MonTableau) As Cell
 'Création de 3 lignes
 'une ligne d'images , une ligne de descriptifs, une ligne de séparation
 Dim rowNew As Row
'ligne photo
 Set rowNew = MonTableau.Rows.Add
 rowNew.Height = MillimetersToPoints(50)
' on retourne la première cellule de la ligne photo
 Set CréerNewLgTableau = rowNew.Cells(1)
'ligne descriptif
Set rowNew = MonTableau.Rows.Add
 rowNew.Height = MillimetersToPoints(5)
 rowNew.Cells(1).Range.Text = "Descriptif"
 rowNew.Cells(2).Range.Text = "Descriptif"
'ligne de séparation
Set rowNew = MonTableau.Rows.Add
 rowNew.Height = MillimetersToPoints(1)
End Function
 
Sub InsérerImage(MonTableau, FichierImage)
Dim CellVideOK As Boolean
 CellVideOK = False
'Recherche de la première cellule vide dans le tableau
    Debug.Print MonTableau.Rows.Count
    For Each Ligne In MonTableau.Rows
        'on ne teste que les lignes modulo 3 (ligne 1, 4 etc)
        If (Ligne.Index - 1) Mod 3 = 0 Then
           'on ne prend que les cellules de colonne 1,2
            For x = 1 To 2 Step 1
                'test si cellule vide
                If Ligne.Cells(x).Range.Text = Chr(13) & Chr(7) Then
                    CellVideOK = True
                    Ligne.Cells(x).Range.InlineShapes.AddPicture FileName:=FichierImage
                    Exit Sub
                End If
            Next
        End If
    Next
    'si aucune cellule libre n'a été trouvée on crée une série de nouvelles lignes
    If Not CellVideOK Then
         CréerNewLgTableau(MonTableau).Range.InlineShapes.AddPicture FileName:=FichierImage
    End If
End Sub

Et voici le fichier Word que j'ai :
Test photos JOD 4 base saine.docx

Je vous remercie d'ores et déjà pour votre aide précieuse.

Excellente journée à vous tous.

[Invité]

Bonjour,

Pour la partie 1, le plus simple serait de créer un objet QuickPart :

Pièce jointe 544154

De le sauvegarder dans votre bibliothèque Building Blocks


Pièce jointe 544157

Et de s'en servir au point de sélection en cliquant sur l'objet :

Pièce jointe 544158

En VBA, la création d'un tableau au point de sélection serait de cette forme :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
 
Sub InsertionDossierPhoto()
 
    With Application.Templates("C:\Users\erick\AppData\Roaming\Microsoft\Document Building Blocks\1036\16\Building Blocks.dotx")
         .BuildingBlockEntries("PresentationDossierPhoto").Insert Where:=Selection.Range, RichText:=True
    End With
 
End Sub

En ce qui concerne la sélection des photos, une solution consisterait à passer par une boite de dialogue que vous pourriez développer selon le modèle contenu dans le fichier de ce post :
recuperer-nom-fichiers-present-dossier

[dadoo99]

Bonjour Eric,

Merci pour votre réponse et votre aide. L'insertion du tableau fonctionne parfaitement y.c. via la macro. Merci beaucoup.

Pour la suite, votre renvoi à la discussion ne m'est pas utile car je travaille sur Word et que je ne souhaite pas faire la même chose qu'Amandon.

En fait je souhaite insérer toutes les photos d'un dossier avec leur nom qui viendrait automatiquement soit dessous la photo dans la même cellule du tableau, soit (encore mieux) dans la ligne suivante et cela sans l'extension .jpg.

Le code que j'ai permet d'insérer les photos correctement, mais insère uniquement "Descriptif" dans la ligne en dessous. C'est là que je souhaiterais qu'apparaisse le nom de la photo.

Encore merci pour vos premières explications et j'espère à très vite pour me dire si vous pensez qu'une solution existe.

Bonne journée.

[Invité]

Bonjour,

Le renvoi vers l'autre discussion montre comment charger différents renseignements dans une matrice pour s'en servir ensuite. Il vous suffirait donc d'atteindre la dernière cellule du tableau injecté depuis le quickpart pour coller le nom du fichier dans le range de la cellule.

[dadoo99]

Merci Eric,

C'est gentil, mais mon niveau en VBA est malheureusement limité (voire très limité).

J'ai tenté de comprendre et modifié le code, mais pas moyen...

Voici en résumé ce que je souhaite faire :



Merci pour votre soutien
Damien

[Invité]

Bonjour,

Un autre exemple sur mon blog : chargement-automatique-photos mais sous Excel.

[dadoo99]

Grâce à Eric,

J'ai pu obtenir le code qu'il me fallait pour gagner ÉNORMÉMENT de temps.

Encore merci à toi Eric...

Damien