Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3 si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3 si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3 si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférable
de lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,
et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de news:
ck3urf$iff$Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférable
de lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,
et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" <BZHpatcat.nats@tiscali.fr> a écrit dans le message de news:
ck3urf$iff$1@news.tiscali.fr...
Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférable
de lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,
et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de news:
ck3urf$iff$Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Ok et merci Raymond,
Je cherche...
Patrice
"Raymond [mvp]" a écrit dans le message de
news:Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférablede lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de
news:
ck3urf$iff$Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
filmspour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriéess'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
dufilm (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
sic'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
StringDim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Ok et merci Raymond,
Je cherche...
Patrice
"Raymond [mvp]" <XYZ.access.seneque@free.fr> a écrit dans le message de
news:OsvJ68JrEHA.376@TK2MSFTNGP14.phx.gbl...
Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférable
de lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,
et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" <BZHpatcat.nats@tiscali.fr> a écrit dans le message de
news:
ck3urf$iff$1@news.tiscali.fr...
Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
films
pour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriées
s'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
du
film (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
si
c'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
String
Dim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Ok et merci Raymond,
Je cherche...
Patrice
"Raymond [mvp]" a écrit dans le message de
news:Bonsoir.
la valeur de CtrlFormatFichier, tu veux la prendre où ? il serait
préférablede lui affecter une constante énumérée qui serait plus parlante que 1 ou
2,et la faire apparaître dans les arguments.
le strFiltre me semble bon.
à suivre.
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de
news:
ck3urf$iff$Bonjour,
Je suis sur ma base Ciné et je veux supprimer les lien OLE sur mon
formulaire pour l'affichage de l'image.
J'utilise donc ton module "Open file" qui me sert pour le chemin des
filmspour récupérer aussi le chemin de l'image.
Seulement voilà le truc : j'aurais souhaité que les extensions
appropriéess'affichent dans l'explorateur qui s'ouvre ....
J'avais pensé (mal je te l'accorde ;o((( mettre un contrôle
[CtrlFormatFichier] dans mon formulaire qui prend la valeur 1 si c'est
dufilm (avi, mpg, etc...), 2 si c'est de l'image (jpg, bmp, etc...) et 3
sic'est du document (doc, mdb, xls, etc...)
Mais l'apprenti sorcier n'y arrive pas...
Peux-tu (une fois de plus...) m'aider ?
Patrice
Ci après la mauvaise idée des transformations apportées aux sections
concernées du module :
Public Function OpenFile(Optional InitialFolder As String = "", _
Optional MultiSelect As Selection = Mono_Sélection, _
Optional ModalWindow As Boolean = True _
) As String
Dim CtrlFormatFichier As Byte 'Apport Patrice
OpenFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg;*.mpeg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg;*.jpeg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
If ModalWindow Then
.hwndOwner = Access.hWndAccessApp
Else
.hwndOwner = 0
End If
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpInitialFolder = InitialFolder
.lpstrTitle = "Recherche d'un fichier"
If MultiSelect = Mono_Sélection Then
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.Flags = 6148
Else
.lpstrFile = Space(4094)
.nMaxFile = 4095
.lpstrFileTitle = Space(4094)
.nMaxFileTitle = 4095
.Flags = 6148 Or OFN_FileMustExist _
Or OFN_EXPLORER _
Or OFN_AllowMultiSelect
End If
End With
RetVal = GetOpenFileName(Dialogue)
If RetVal = 0 Then
OpenFile = ""
nOpenFile = 0
Exit Function
End If
OpenFile = Trim(Dialogue.lpstrFile)
OpenFile = Left(OpenFile, Len(OpenFile) - 1)
OpenFile = Replace(OpenFile, Chr(0), ";")
tOpenFile = Split(OpenFile, ";")
If UBound(tOpenFile) = 0 Then
nOpenFile = 1
ElseIf UBound(tOpenFile) = 1 Then
OpenFile = Replace(OpenFile, ";", "")
nOpenFile = 1
Else
nOpenFile = UBound(tOpenFile) - 1
End If
End Function
Public Function SaveFile(Optional InitialFolder As String = "") As
StringDim CtrlFormatFichier As Byte 'Apport Patrice
SaveFile = ""
If InitialFolder = "" Then InitialFolder = CurrentProject.Path
If CtrlFormatFichier = 1 Then 'Ciné 'Apport Patrice
strFiltre = _
"Fichiers Mpg" & Chr$(0) & "*.mpg" & Chr$(0) & _
"Fichiers Avi" & Chr$(0) & "*.avi" & Chr$(0) & _
"Fichiers Wmv" & Chr$(0) & "*.wmv" & Chr$(0) & _
"Fichiers Asx" & Chr$(0) & "*.asx" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 2 Then 'Images
strFiltre = _
"Fichiers Jpg" & Chr$(0) & "*.jpg" & Chr$(0) & _
"Fichiers Bmp" & Chr$(0) & "*.bmp" & Chr$(0) & _
"Fichiers Wmf" & Chr$(0) & "*.wmf" & Chr$(0) & _
"Fichiers Tif" & Chr$(0) & "*.tif" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
ElseIf CtrlFormatFichier = 3 Then 'Documents
strFiltre = _
"Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _
"Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _
"Fichiers Word" & Chr$(0) & "*.doc" & Chr$(0) & _
"Tous les fichiers" & Chr$(0) & "*.*"
End If
With Dialogue
.hwndOwner = Access.hWndAccessApp
.lStructSize = Len(Dialogue)
.lpstrFilter = strFiltre
.lpstrFile = Space(254)
.nMaxFile = 255
.lpstrFileTitle = Space(254)
.nMaxFileTitle = 255
.lpInitialFolder = InitialFolder
.lpstrTitle = "Sauvegarde d'un fichier"
.Flags = 6148
End With
RetVal = GetSaveFileName(Dialogue)
If RetVal >= 1 Then
SaveFile = Trim(Dialogue.lpstrFile)
SaveFile = Replace(SaveFile, Chr(0), "")
Else
SaveFile = ""
Exit Function
End If
End Function
Re,
çà va beaucoup mieux...merci.
Patrice
Re,
çà va beaucoup mieux...merci.
Patrice
Re,
çà va beaucoup mieux...merci.
Patrice
Bonjour.
il ne faut pas faire appel à une donnée de formulaire dans une fonction
généraliste sinon elle ne sera plus généraliste.
j'ai modifié ma fonction pour ajouter un type de fichier en fin de
paramètres. tu la trouveras sur la page :
http://access.vba.free.fr/boiteopen.htm
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de news:
ck4dse$2mq$Re,
çà va beaucoup mieux...merci.
Patrice
Bonjour.
il ne faut pas faire appel à une donnée de formulaire dans une fonction
généraliste sinon elle ne sera plus généraliste.
j'ai modifié ma fonction pour ajouter un type de fichier en fin de
paramètres. tu la trouveras sur la page :
http://access.vba.free.fr/boiteopen.htm
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" <BZHpatcat.nats@tiscali.fr> a écrit dans le message de news:
ck4dse$2mq$1@news.tiscali.fr...
Re,
çà va beaucoup mieux...merci.
Patrice
Bonjour.
il ne faut pas faire appel à une donnée de formulaire dans une fonction
généraliste sinon elle ne sera plus généraliste.
j'ai modifié ma fonction pour ajouter un type de fichier en fin de
paramètres. tu la trouveras sur la page :
http://access.vba.free.fr/boiteopen.htm
--
@+
Raymond Access MVP
http://access.seneque.free.fr/
http://access.vba.free.fr/
http://access2003.free.fr/
http://users.skynet.be/mpfa/ pour débuter sur le forum
"PatCatNat's" a écrit dans le message de news:
ck4dse$2mq$Re,
çà va beaucoup mieux...merci.
Patrice
