XL 2016 Affichage d'une photo jpeg avec visionneus windows.

Dam1904

XLDnaute Nouveau
Bonjour à tous,

Système d'exploitation : Windows 7

J'aimerais trouver un code vba qui me permettrait d'afficher la photo d'un article à l'aide de la visionneuse windows et cela en appuyant sur un bouton de commande.
Pour ce faire, mon fichier Excel ainsi que les photos d'articles se trouvent dans le même répertoire, le fichier à un nombre variable de feuilles (suivant son utilisation), une feuille et la cellule "B2" de celle-ci se nomment comme l'article. Donc, la fonction doit pouvoir être dupliquée lors de l'ajout d'une nouvelle feuille.

Voici mon code :

Option Explicit
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
(ByVal hwnd As Long, ByVal lpOperation As String, _
ByVal lpFile As String, ByVal lpParameters As String, _
ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub afficherphoto()
Dim Chemin As String
Dim NomImage As String
Dim Image As String
Chemin = "C:\Users\FID166\Documents\Prg HT\" & Range("B2")
NomImage = Range("B2")
Image = ".jpg"
'choix du dossier
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = Chemin
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Image JPEG", "*.jpg"
If .Show <> 0 Then
Image = .SelectedItems(1)
Else
Exit Sub
End If
End With
'puis ouvrir l'image avec la visionneuse
afficherImage_ApercuWindows Image
End Sub
Sub afficherImage_ApercuWindows(Img As String)
'puis ouvrir l'image sélectionnée par la macro en feuille 1, avec la visionneuse
ShellExecute 0, "open", "rundll32.exe", _
"C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & Img, 0, 3
End Sub

Ce code est inséré dans un module du "VBAProject et celui qui suit dans un module de la feuille 1

Private Sub photo()
Dim Chemin As String
Dim NomImage As String
Dim Image As String
Chemin = "C:\Users\FID166\Documents\Prg HT\" & Range("B2")
NomImage = Range("B2")
Image = ".jpg"
'choix du dossier
With Application.FileDialog(msoFileDialogFilePicker)
.InitialFileName = Chemin
.AllowMultiSelect = False
.Filters.Clear
.Filters.Add "Image JPEG", "*.jpg"
If .Show <> 0 Then
Image = .SelectedItems(1)
Else
Exit Sub
End If
End With
'puis ouvrir l'image avec la visionneuse
afficherImage_ApercuWindows Image
End Sub
Private Sub Worksheet_Activate()
photo
End Sub


Ce code fonctionne, la boîte de dialogue s'ouvre et me propose bien le "nom de l'article" à ouvrir, je confirme par "OK" et la visionneuse ouvre la photo, cependant j'aimerais que la photo s'ouvre automatiquement sans devoir valider par "OK"


Merci pour votre aide !
 

jmfmarques

XLDnaute Accro
Bonjour
Ce que tu décris là n'a rien à voir avec la visionneuse.
Seul est concerné le fonctionnement de la boîte de dialogue utilisée, fonctionnement qui est le même quel que soit le fichier choisi (il ne s'agit à ce stade que de choix d'un fichier)
Je crois comprendre que le fonctionnement en cause ne te plait pas. si tel est le cas, il t'est loisible d'effectuer ce choix de fichier à l'aide d'autre chose que cette boîte de dialogue (une listbox, par exemple ? )
j'appelle par ailleurs ton attention sur le fait que la nécessité de ce "OK" n'est plus là en réponse à un double-clic plutôt qu'un clic.
 
Dernière édition:

patricktoulon

XLDnaute Barbatruc
bonsoir le fil

version 1 api shell execute

VB:
Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" _
                              (ByVal hwnd As Long, ByVal lpOperation As String, _
                               ByVal lpFile As String, ByVal lpParameters As String, _
                               ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Sub methode_1_Api()
    Dim fichier As String
'Dialog   
 fichier = Application.GetOpenFilename("image Files (*.jpg;*.gif;*.png;*.bmp), *.jpg;*.gif;*.png;*.bmp", 1, "ouvrir un fichier")
    If fichier = "" Then Exit Sub
    
    ShellExecute 0, "open", "rundll32.exe", _
                 "C:\WINDOWS\System32\shimgvw.dll,ImageView_Fullscreen " & fichier, 0, 3

End Sub

version 2 wscript.shell(ouverture avec l'application par défaut mémorise dans registre

VB:
Sub methode_2_Ws_Shell()
    Dim fichier As String
    'Dialog
    fichier = Application.GetOpenFilename("image Files (*.jpg;*.gif;*.png;*.bmp), *.jpg;*.gif;*.png;*.bmp", 1, "ouvrir un fichier")
    If fichier = "" Then Exit Sub
    
    'ouverture dans l application par defaut(pas forcement la visioneuse)
    CreateObject("Wscript.Shell").Run "CMD.EXE /C " & Chr(34) & fichier & Chr(34), 0, True
End Sub

version 3 wscript.shell ouverture visionneuse w7

VB:
Sub methode_3_Ws_Shell()
    fichier = Application.GetOpenFilename("image Files (*.jpg;*.gif;*.png;*.bmp), *.jpg;*.gif;*.png;*.bmp", 1, "ouvrir un fichier")
    If fichier = "" Then Exit Sub
    
  'ouverture dans la visioneuse windows
     Cmd = "rundll32.exe %windir%\system32\shimgvw.dll,ImageView_Fullscreen"
   CreateObject("wscript.shell").Exec (Cmd & " " & fichier)
End Sub
 

patricktoulon

XLDnaute Barbatruc
re
en fouillant dans mes archives vba cette fois ci j'en ai trouvé une 4me avec shell vba
VB:
Sub methode_4__Shell()
Dim fichier As String

    'Dialog
    fichier = Application.GetOpenFilename("image Files (*.jpg;*.gif;*.png;*.bmp), *.jpg;*.gif;*.png;*.bmp", 1, "ouvrir un fichier")
    If fichier = "" Then Exit Sub
'ouverture dans la visioneuse windows

Shell "Rundll32.exe C:\Windows\System32\Shimgvw.dll,ImageView_Fullscreen " & fichier
End Sub

j'oubliais pour sélectionner sans ok double click sur le fichier pour les 4 méthodes
 
Dernière édition:

jmfmarques

XLDnaute Accro
j'oubliais pour sélectionner sans ok double click sur le fichier pour les 4 méthodes

j'appelle par ailleurs ton attention sur le fait que la nécessité de ce "OK" n'est plus là en réponse à un double-clic plutôt qu'un clic.
et si on le disait 10 fois de plus ?
En rappelant au passage que c'était sur CE point (et aucun autre) , que Dam1004 souhaitait de l'aide.
Pour mémoire :
Ce code fonctionne, la boîte de dialogue s'ouvre et me propose bien le "nom de l'article" à ouvrir, je confirme par "OK" et la visionneuse ouvre la photo, cependant j'aimerais que la photo s'ouvre automatiquement sans devoir valider par "OK"
:cool:
 

Discussions similaires

Réponses
12
Affichages
703
  • Question
Microsoft 365 Code VBA
Réponses
10
Affichages
701
Réponses
1
Affichages
413
Compte Supprimé 979
C

Statistiques des forums

Discussions
314 626
Messages
2 111 297
Membres
111 093
dernier inscrit
Yvounet