Gérer images avec plusieurs extension

Version imprimable

Bonjour,

Je suis entrain de crée un USF pour gérer des données avec des images qui a était réaliser en partie par mercatog que je salut et remercie beaucoup au passage.
Parmi ces données je souhaiterais pouvoir gérer des images avec plusieurs extension soit
".GIF; *.jpg; *.bmp;*.PNG" je pense qu'un filtre devrait suffire mais je ne sais pas comment faire?

Code:

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
Private Sub ComboBox1_Change()                   'au changement dans la ComboBox1
Dim r As Range                                   'déclare la variable r (Recherche)
Dim Ld As Integer                                'déclare la variable ld (Ligne de Départ)
Dim Lf As Integer                                'déclare la variable lf (Ligne de Fin)
Dim i As Integer                                 'déclare la variable i (incrément)
 
Me.ListBox1.Clear                                'vide la ListBox1
With Sheets("Feuil1")                            'prend en compte l'onglet "Feuil1"
    Lf = .Cells(.Rows.Count, 8).End(xlUp).Row    'définit la ligne de fin
    Set r = .Columns(8).Find(Me.ComboBox1.Value, , xlValues, xlWhole)    'définit la recherche
    If Not r Is Nothing Then                     'condition : si il existe au moins une occurrence
        Ld = r.Row + 1                             'définit la ligne de départ
        Set r = Nothing
        For i = Ld To Lf                     'boucle de la ligne de départ à la ligne de fin
            If UCase(.Cells(i, 8)) <> .Cells(i, 8) Then    'si la couleur de la cellule est "jaune clair", sort de la procédure
                Me.ListBox1.AddItem .Cells(i, 8)    'ajoute la valeur de la cellule en colonne H à la ListBox1
            Else
                Exit For
            End If
        Next i                                   'prochaine ligne de la boucle
    Else                                         'sinon
        MsgBox "Région non trouvée !"            'message
    End If                                       'fin de la condition
End With                                         'fin de la prise en compte de l'onglet "Feuil1"
'Stop
 
' Partie logo régions
Nom = ComboBox1
 
 
Fichier = ActiveWorkbook.Path & "\Blason_départements_et_régions\" & Nom & ".jpg"
 
    If Dir(Fichier) <> "" Then
        Me.Image1.Picture = LoadPicture(Fichier)
            Else
        On Error Resume Next: Me.Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\Blason_départements_et_régions\" & "vide.jpg")
 
    End If
    'Stop
 
 
End Sub

J'ai trouver ceci mais je n'arrive pas a inclure dans mon code

Code:

1
2
3
4
5
' Ajouter un filtre qui comprend des images GIF et JPEG et rendent le premier élément dans la liste.
        .Filters.Add "Images", "*.gif; *.jpg; *.bmp;*.PNG", 1
        .Title = "Choisissez une image"
        .InitialFileName = " C:\Users\MaVal\Desktop\Carte de france complet\Blason_départements_et_régions\"
        .InitialView = msoFileDialogViewThumbnail 'afficher les miniature

je vous remercie de votre aide

Cordialement

max

Essaies comme ceci

Code:

1
2
3
4
5
Fichier = ActiveWorkbook.Path & "\Blason_départements_et_régions\" & Nom 'Sans extention
Fichier = Dir(Fichier & ".*")
If Fichier <> "" Then
    Me.Image1.Picture = LoadPicture(Fichier)
Else

20/08/2012, 12h01
maxval18

Bonjour mercatog,

Merci d'avoir d'avoir répondu.
Après avoir mis ton morceau de code j'ai un message d'erreur image incorrecte et il me surligne cette ligne:

Code:

Me.Image1.Picture = LoadPicture(Fichier)

@+
Max

Oui effectivement, il fallait indiquer le chemin

Code:

1
2
3
4
5
6
7
8
Dim Chemin As String
 
'...
Chemin = ThisWorkbook.Path & "\Blason_départements_et_régions\"
Fichier = Chemin & Nom    'Sans extention
Fichier = Dir(Fichier & ".*")
If Fichier <> "" Then
    Me.Image1.Picture = LoadPicture(Chemin & Fichier)

Re,

Nom toujours le même message d'erreur.

Code:

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
Private Sub ComboBox1_Change()                   'au changement dans la ComboBox1
Dim r As Range                                   'déclare la variable r (Recherche)
Dim Ld As Integer                                'déclare la variable ld (Ligne de Départ)
Dim Lf As Integer                                'déclare la variable lf (Ligne de Fin)
Dim i As Integer                                 'déclare la variable i (incrément)
 
Me.ListBox1.Clear                                'vide la ListBox1
With Sheets("Feuil1")                            'prend en compte l'onglet "Feuil1"
    Lf = .Cells(.Rows.Count, 8).End(xlUp).Row    'définit la ligne de fin
    Set r = .Columns(8).Find(Me.ComboBox1.Value, , xlValues, xlWhole)    'définit la recherche
    If Not r Is Nothing Then                     'condition : si il existe au moins une occurrence
        Ld = r.Row + 1                             'définit la ligne de départ
        Set r = Nothing
        For i = Ld To Lf                     'boucle de la ligne de départ à la ligne de fin
            If UCase(.Cells(i, 8)) <> .Cells(i, 8) Then    'si la couleur de la cellule est "jaune clair", sort de la procédure
                Me.ListBox1.AddItem .Cells(i, 8)    'ajoute la valeur de la cellule en colonne H à la ListBox1
            Else
                Exit For
            End If
        Next i                                   'prochaine ligne de la boucle
    Else                                         'sinon
        MsgBox "Région non trouvée !"            'message
    End If                                       'fin de la condition
End With                                         'fin de la prise en compte de l'onglet "Feuil1"
'Stop
 
' Partie logo régions
Nom = ComboBox1
 
  Dim Chemin As String
 
'...
Chemin = ThisWorkbook.Path & "\Blason_départements_et_régions\"
Fichier = Chemin & Nom    'Sans extention
Fichier = Dir(Fichier & ".*")
If Fichier <> "" Then
    Me.Image1.Picture = LoadPicture(Chemin & Fichier)
 
            Else
            On Error Resume Next: Me.Image1.Picture = LoadPicture(ActiveWorkbook.Path & "\Blason_départements_et_régions\" & "vide")
 
    End If
    'Stop
 
End Sub

@+
Max

J'ai ajouté un test pour être sûr de ne prendre que les fichiers images.
Dans ton dossier si tu as des fichiers qui ont le même non que le fichier image souhaité, le code n'affichera rien

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim Chemin As String
Dim Trouve As Boolean
'...
Chemin = ThisWorkbook.Path & "\Blason_départements_et_régions\"
 
Fichier = Chemin & Nom                             'Sans extention
Fichier = Dir(Fichier & ".*")
If Fichier <> "" Then
    Trouve = True
    If InStr("jpg,bmp,png,gif,jpeg", Mid(Fichier, InStrRev(Fichier, ".") + 1)) = 0 Then Trouve = False
End If
If Not Trouve Then Fichier = "vide.jpg"
 
MsgBox Chemin & Fichier
Me.Image1.Picture = LoadPicture(Chemin & Fichier)

PS: Regarde ce que te donne la msgbox (pour le test)

Dans le cas où dans ton dossier tu as plusieurs fichier portant le même nom avec des extensions différentes, je propose ce code

Code:

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
Dim Chemin As String
 
'...
Chemin = ThisWorkbook.Path & "\Blason_départements_et_régions\"
 
Fichier = Chemin & Nom                             'Sans extention
Fichier = Dir(Fichier & ".*")
If Fichier <> "" Then
    Do Until InStr("jpg,bmp,png,gif,jpeg", Mid(Fichier, InStrRev(Fichier, ".") + 1)) > 0
        Fichier = Dir
    Loop
End If
If Fichier = "" Then Fichier = "vide.jpg"
MsgBox Chemin & Fichier
 
Me.Image1.Picture = LoadPicture(Chemin & Fichier)
End Sub

20/08/2012, 14h12
maxval18

1 pièce(s) jointe(s)

Re,

Non toujours pareil je joint mon fichier avec quelques images en "gif et png"

Si je met que des image en JPG aucun probléme?

@+
20/08/2012, 14h23
mercatog

Le problème ne vient pas du code mais le format png n'est pas supporté
contrairement aux formats bmp, gif et jpg
20/08/2012, 14h31
maxval18

Re,

J'ai supprimer les images avec ext. PNG et j'ai laisser les images avec ext. Gif et Jpg les images Jpg pas de problème les images gif sa ne passe pas?

@+
20/08/2012, 14h40
mercatog

Chez moi je n'ai rencontré aucun problème avec les gif et bmp
D'ailleur, crée un nouvel userform avec un contrôle image, et dans sa propriété Picture, choisi une image gif.
20/08/2012, 14h52
maxval18

Re,

Oui autant pour moi je n'avais pas rectifier le code a la listbox.
Mais une question pourquoi les images sur dans le contrôle image de l'USF ne sont-il pas net?

@+
Max