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
|
Sub Test()
Dim Fichier1 As String, Repertoire As String
Dim I As Integer, Pos As Integer, a As Integer
Repertoire = "C:\Users\jaushua_fixe\Documents\picto\interdiction\"
I = 1
For Pos = 1 To 1 ' A adapter
For a = 10 To 12
' Fichier1 = Repertoire & Worksheets("BD").Cells(Pos, a).Value ' Si le nom de l'image contient déjà son extension
Fichier1 = Repertoire & Worksheets("BD").Cells(Pos, a).Value & ".JPG"
Debug.Print Fichier1
If Dir(Fichier1) <> "" And ExistenceShape(Sheets("Fiche"), I) = True Then
'Sheets("Fiche").Shapes("Image" & I).Fill.UserPicture Fichier1 ' Attention à la syntaxe
Sheets("Fiche").Shapes("image" & I).Fill.UserPicture Fichier1
I = I + 1
End If
Next a
Next Pos
End Sub
Function ExistenceShape(ByVal ShFiche As Worksheet, ByVal NumeroImage As Byte) As Boolean
Dim J As Integer
ExistenceShape = False
With ShFiche
If .Shapes.Count = 0 Then Exit Function
For J = 1 To .Shapes.Count
'If .Shapes(J).Name = "Image" & NumeroImage Then ' Attention à la syntaxe
If .Shapes(J).Name = "image" & NumeroImage Then
ExistenceShape = True
Exit Function
End If
Next J
End With
End Function |
