Discussion :

[irimi54]

J'ai été obligé de réinstaller mon Office 2019 et mes programmes bugue un peu. Notamment quand je veux afficher un fichier image à partir de mon formulaire.
J'utilise la fonction "GetOpenFileName". Est ce que la référence adéquate aurait disparu?
je ne peux pas non plus afficherl'image en cliquant dessus quand elle est affichée dans mon formulaire



je joins le code de mon module de fonction

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
101
102
103
104
105
Option Compare Database
Option Explicit
 
'Déclaration de l'API
Private Declare PtrSafe Function GetOpenFileName Lib "comdlg32.dll" Alias _
                   "GetOpenFileNameA" (pOpenfilename As OPENFILENAME) As Long
Private Declare PtrSafe 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
 
 'Structure du fichier
Private Type OPENFILENAME
    lStructSize As Long
    hwndOwner As LongPtr
    hInstance As LongPtr
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As LongPtr
    lpfnHook As LongPtr
    lpTemplateName As String
End Type
 
 'Constantes
Private Const OFN_READONLY = &H1
Private Const OFN_OVERWRITEPROMPT = &H2
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_NOCHANGEDIR = &H8
Private Const OFN_SHOWHELP = &H10
Private Const OFN_ENABLEHOOK = &H20
Private Const OFN_ENABLETEMPLATE = &H40
Private Const OFN_ENABLETEMPLATEHANDLE = &H80
Private Const OFN_NOVALIDATE = &H100
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXTENSIONDIFFERENT = &H400
Private Const OFN_PATHMUSTEXIST = &H800
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_CREATEPROMPT = &H2000
Private Const OFN_SHAREAWARE = &H4000
Private Const OFN_NOREADONLYRETURN = &H8000
Private Const OFN_NOTESTFILECREATE = &H10000
 
Private Const OFN_SHAREFALLTHROUGH = 2
Private Const OFN_SHARENOWARN = 1
Private Const OFN_SHAREWARN = 0
 
Private Declare PtrSafe Function SHGetSpecialFolderPath Lib "shell32.dll" Alias "SHGetSpecialFolderPathA" _
                                                (ByVal hwndOwner As Long, ByVal lpszPath As String, _
                                                 ByVal nFolder As Long, ByVal fCreate As Long) As Long
 
Public Function GetSpecialFolderPath(dossier As Long, hwnd As Long)
 Dim buffer As String
 buffer = Space(256)
SHGetSpecialFolderPath hwnd, buffer, dossier, 0
GetSpecialFolderPath = Left(buffer, InStr(buffer, Chr(0)) - 1)
 
End Function
 
Public Function OuvrirUnFichier(Handle As Long, _
                                Titre As String, _
                                TypeRetour As Byte, _
                                Optional TitreFiltre As String, _
                                Optional TypeFichier As String) As String
Dim StructFile As OPENFILENAME
Dim sFiltre As String
 
 'Construction du filtre en fonction des arguments spécifiés
If Len(TitreFiltre) > 0 And Len(TypeFichier) > 0 Then
  sFiltre = TitreFiltre & " (" & TypeFichier & ")" & Chr$(0) & "*." & TypeFichier & Chr$(0)
End If
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
 
 
 'Configuration de la boîte de dialogue
  With StructFile
    .lStructSize = Len(StructFile) 'Initialisation de la grosseur de la structure
    .hwndOwner = Handle 'Identification du handle de la fenêtre
    .lpstrFilter = sFiltre 'Application du filtre
    .lpstrFile = String$(254, vbNullChar) 'Initialisation du fichier '0' x 254
    .nMaxFile = 254 'Taille maximale du fichier
    .lpstrFileTitle = String$(254, vbNullChar) 'Initialisation du nom du fichier '0' x 254
    .nMaxFileTitle = 254  'Taille maximale du nom du fichier
    .lpstrTitle = Titre 'Titre de la boîte de dialogue
    .flags = OFN_HIDEREADONLY  'Option de la boite de dialogue
  End With
 
  If (GetOpenFileName(StructFile)) Then 'Si un fichier est sélectionné
    Select Case TypeRetour
      Case 1: OuvrirUnFichier = Trim$(StructFile.lpstrFile)
      Case 2: OuvrirUnFichier = Trim$(StructFile.lpstrFileTitle)
    End Select
  End If
 
End Function

je ne sais pas si mes explications sont claires

merci d'avance

[deedolith]

Salut,

Non, c'est une API, il n'y a pas de référence, vérifie tes déclarations.

Quid de passer par l'objet Office.FileDialog qui offre fait exactement la même chose (sans API) ?

[irimi54]

tout simplement parce que je ne connais pas cet fonction et donc ne sais pas comment m'en servir.

mon code si dessus fonctionnait très bien avant de passe en 64b. Je cliquais sur un bouton pour aller chercher un fichier dans un répertoire et l'image apparaissais dans mon formulaire.

[deedolith]

Il est temps d'apprendre:
https://learn.microsoft.com/fr-fr/of...ice.filedialog

[User]

Bonjour,

J'ajouterais qu'il faut que tu regardes comment est appelée ta fonction : sur quel évènement et quels sont ces arguments pour que tu comprennes comment créer ta nouvelle fonction avec filedialog.

Cdlt,

[irimi54]

ok je vais tenter de faire tout cela

Merci

[irimi54]

Bonjour

deedolith tu me conseillais de prendre la filedialog mais n'arrive à rien .

en revanche se que ne comprend pas avec l'API GetOpenFileName, c'est que cela fonctionnait bien avec la version 32 bits. Cela bloque depuis que je suis passé à la 64b .
C'est bizarre , non?

j'ai rajouter PtrSafe dans la ligne rivate Declare PtrSafe Function GetOpenFileName Lib a chaque fois qu'il y a "declare function" et
transformer "Long" en "LongPtr" dans les declaration d'Alias comme ici "hwndOwner As LongPtr"

[deedolith]

deedolith tu me conseillais de prendre la filedialog mais n'arrive à rien .

Heu …,

Je te fourni la meilleur source disponible pour utiliser l'objet FileDialog (le site de Microsoft), avec:
- Le détail des arguments pour instancier l'objet.
- Le détail des membres pour le manipuler.
- Un exemple de code fonctionnel, que tu peux copier / coller / expérimenter / adapter à ton besoin.
Et ca ne te mènes à rien ?

Soit il faut faire des efforts,
Soit il faut sortir du tunnel "API a tout prix", prendre du recul, sortir du cadre.

Les API c'est bien, mais quand il y a quelque chose capable de faire la même chose, plus facilement, plus portable et plus versatile, mon choix est fait !

[irimi54]

ok je vais tenter le coup de filedialog

merci

[irimi54]

j'ai tenté le coup et au bout de 2 jours , j'ai réussi.

Je mets le code si cela peut servir à d'autres:

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
 
Private Sub parcourir_Click()
Dim strchemin As String
Dim Nom_Fichier As String
Dim oFD As Object
'Paramètre la fenêtre Ouvrir
Set oFD = Application.FileDialog(msoFileDialogOpen)
With oFD
    'Ajoute les filtres pour fichiers textes et tous
    With .Filters
        .Clear
        .Add "Fichiers image", "*.jpeg", 1
        .Add "Tous", "*.*", 2
    End With
    'Aucun nom de fichier par défaut
    .InitialFileName = ""
    'Interdit la multi sélection
    .AllowMultiSelect = False
    'Affiche la fenêtre et vérifie qu'un fichier a bien été choisi
    If .Show Then
        'MsgBox .SelectedItems(1)
        Nom_Fichier = oFD.SelectedItems(1)
        Call ChargerUneImage(Nom_Fichier)
    End If
End With
End Sub
 
Private Sub ChargerUneImage(Fichier)
   DoCmd.RunSQL "UPDATE Salarie SET Salarie.Photo = """ & Fichier & """  WHERE (((Salarie.ID_Num)=[Formulaires]![F_acces_fichier]![ID_Num])); "
   Forms!F_acces_fichier.Refresh
End Sub

puis si je clique sur la photo sur le formulaire , elle s'affiche en grand avec l'application "XnView" (par defaut chez moi)

Merci beaucoup