Gérer images avec plusieurs extension

**maxval18** · 20/08/2012, 11h33

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 :

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
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 :

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

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

**mercatog** · 20/08/2012, 11h53

Essaies comme ceci

Code :

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

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

**maxval18** · 20/08/2012, 12h01

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 :

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

 Me.Image1.Picture = LoadPicture(Fichier)

@+
Max

**mercatog** · 20/08/2012, 12h09

Oui effectivement, il fallait indiquer le chemin

Code :

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

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)

**maxval18** · 20/08/2012, 13h00

Re,

Nom toujours le même message d'erreur.

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
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

**mercatog** · 20/08/2012, 13h34

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 :

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

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 :

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
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

**maxval18** · 20/08/2012, 14h12

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?

@+

**mercatog** · 20/08/2012, 14h23

Le problème ne vient pas du code mais le format png n'est pas supporté
contrairement aux formats bmp, gif et jpg

**maxval18** · 20/08/2012, 14h31

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?

@+

**mercatog** · 20/08/2012, 14h40

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.

**maxval18** · 20/08/2012, 14h52

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

Gérer images avec plusieurs extension

Macros et VBA Excel

Discussions similaires

Partager

Partager