Bonjour,
J'ai des fiches. Elles sont en format Word. Il y a différentes informations + 2 photos. Prenons un exemple simple : je fais des fiches pour ma collection de petites voitures : il y a 2 photos, et une fiche avec différentes caractéristiques notées.
Par macro, j'ouvre Word, copie/collle les informations et ensuite je les compile dans un tableau Excel :
Mon problème, c'est que j'aimerai pouvoir récupérer le nom des images, ainsi, lorsque j'aurai mon tableau Excel, je ferai un lien hypertexte vers ces images.....
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
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100 Sub MAJ() Dim Chemin As String Dim Fichier As String Dim WordApp As Word.Application Dim WordDoc As Word.Document Dim DerniereLignefichiers As Integer Dim DerniereLignefiches As Integer Dim i As Integer Dim j As Integer Dim k As Integer 'efface données Liste DerniereLignefiches = Sheets("Liste").Range("A65536").End(xlUp).Row Range(Cells(2, 1), Cells(DerniereLignefiches, 68)).Select Selection.ClearContents Range("A2").Select 'efface données Fichiers Sheets("Fichiers").Select Cells.Select Selection.ClearContents Range("A1").Select 'Efface données Temp Sheets("Temp").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select 'lecture des fichiers 'Définit le répertoire contenant les fichiers Chemin = ThisWorkbook.Path & "\Fiches" Fichier = Dir(Chemin & "\*.doc") Do While Len(Fichier) > 0 i = i + 1 Sheets("Fichiers").Cells(i, 1) = Fichier Fichier = Dir() Loop ' Lecture / Ecriture des fiches DerniereLignefichiers = Sheets("Fichiers").Range("A65536").End(xlUp).Row 'Boucle sur fichiers For j = 1 To DerniereLignefichiers Fichier = ThisWorkbook.Path & "\Fiches\" & Sheets("Fichiers").Cells(j, 1) 'creation session Word Set WordApp = New Word.Application 'pour que word reste masqué pendant l'opération WordApp.Visible = False 'ouverture du fichier Word Set WordDoc = WordApp.Documents.Open(Fichier) 'copie le premier tableau Word WordDoc.Range.Copy 'Enleve message alerte Application.DisplayAlerts = False 'colle Sheets("Temp").Paste Stop 'ferme le document Word sans sauvegarde WordDoc.Close False 'ferme l'application Word WordApp.Quit 'ajout dans "fiches" DerniereLignefiches = Sheets("Liste").Range("A65536").End(xlUp).Row k = j 'DerniereLignefiches + 1 'incrémente Différentes formules pour récupérer les cases de word 'Efface données Temp Sheets("Temp").Select Cells.Select Selection.Delete Shift:=xlUp Range("A1").Select Next MsgBox ("Fini") End Sub
Mais dans mon copier/coller, il me copie bien l'image, mais je n'arrive pas à récupérer leur nom....
Une idée ?
Merci,
A+
Partager