Bouton parcourir en VBA (pour Access)

Bouton parcourir en VBA (pour Access) - VB/VBA/VBS - Programmation

Marsh Posté le 17-07-2003 à 10:08:25    

Je cherche un script pour pouvoir faire un petit bouton parcourir pour aller chercher un fichier.
 
J'avais trouvé un script sur Internet mais je ne le retrouve plus  :cry:  
 
Je pensais pouvoir trouver ma réponse ici dans un post déjà existant (mais aucun n'a été crée sur ce sujet).
 
Je sais que c'est compliqué ce que je demande mais si quelqu'un l'a déjà fait, c'est juste une copie de code.
 
Merci
Damien, le noob du VB

Reply

Marsh Posté le 17-07-2003 à 10:08:25   

Reply

Marsh Posté le 18-07-2003 à 15:48:51    

Perso, j'utilise ce code, trouvé sur internet :
 
on l'appelle en faisant : fichieràouvrir = openit()
 

Code :
  1. Option Compare Database
  2. '***************** Code Start **************
  3. 'Ce code fut originalement écrit par Ken Getz
  4. 'Il ne doit être ni altéré, ni distribué
  5. 'sauf comme partie intégrée à une application.
  6. 'Vous êtes libre d'utiliser ce code
  7. 'à la condition de laisser cette note, sans modification.
  8. ' Code courtesy of:
  9. '    Microsoft Access 95 How-To
  10. ' Ken Getz and Paul Litwin
  11. ' Waite Group Press, 1996
  12. Type tagOPENFILENAME
  13.       lStructSize As Long
  14.       hwndOwner As Long
  15.       hInstance As Long
  16.       strFilter As String
  17.       strCustomFilter As String
  18.       nMaxCustFilter As Long
  19.       nFilterIndex As Long
  20.       strFile As String
  21.       nMaxFile As Long
  22.       strFileTitle As String
  23.       nMaxFileTitle As Long
  24.       strInitialDir As String
  25.       strTitle As String
  26.       Flags As Long
  27.       nFileOffset As Integer
  28.       nFileExtension As Integer
  29.       strDefExt As String
  30.       lCustData As Long
  31.       lpfnHook As Long
  32.       lpTemplateName As String
  33. End Type
  34. Declare Function aht_apiGetOpenFileName Lib "comdlg32.dll" _
  35.     Alias "GetOpenFileNameA" (OFN As tagOPENFILENAME) As Boolean
  36. Declare Function aht_apiGetSaveFileName Lib "comdlg32.dll" _
  37.     Alias "GetSaveFileNameA" (OFN As tagOPENFILENAME) As Boolean
  38. Declare Function CommDlgExtendedError Lib "comdlg32.dll" () As Long
  39. Global Const ahtOFN_READONLY = &H1
  40. Global Const ahtOFN_OVERWRITEPROMPT = &H2
  41. Global Const ahtOFN_HIDEREADONLY = &H4
  42. Global Const ahtOFN_NOCHANGEDIR = &H8
  43. Global Const ahtOFN_SHOWHELP = &H10
  44. ' You won't use these.
  45. 'Global Const ahtOFN_ENABLEHOOK = &H20
  46. 'Global Const ahtOFN_ENABLETEMPLATE = &H40
  47. 'Global Const ahtOFN_ENABLETEMPLATEHANDLE = &H80
  48. Global Const ahtOFN_NOVALIDATE = &H100
  49. Global Const ahtOFN_ALLOWMULTISELECT = &H200
  50. Global Const ahtOFN_EXTENSIONDIFFERENT = &H400
  51. Global Const ahtOFN_PATHMUSTEXIST = &H800
  52. Global Const ahtOFN_FILEMUSTEXIST = &H1000
  53. Global Const ahtOFN_CREATEPROMPT = &H2000
  54. Global Const ahtOFN_SHAREAWARE = &H4000
  55. Global Const ahtOFN_NOREADONLYRETURN = &H8000
  56. Global Const ahtOFN_NOTESTFILECREATE = &H10000
  57. Global Const ahtOFN_NONETWORKBUTTON = &H20000
  58. Global Const ahtOFN_NOLONGNAMES = &H40000
  59. ' New for Windows 95
  60. Global Const ahtOFN_EXPLORER = &H80000
  61. Global Const ahtOFN_NODEREFERENCELINKS = &H100000
  62. Global Const ahtOFN_LONGNAMES = &H200000
  63. Function Openit() As String
  64.     Dim strFilter As String
  65.     Dim lngFlags As Long
  66.     strFilter = ahtAddFilterItem(strFilter, "All Files (*.*)", "*.*" )
  67.     Openit = ahtCommonFileOpenSave(InitialDir:="G:\EIF-MIS\Bma\DOCS-Excel\G&E\Inclusions", _
  68.         Filter:=strFilter, FilterIndex:=3, Flags:=lngFlags, _
  69.         DialogTitle:="Select Excel File" )
  70.     ' On a fourni les options dans lngFlags,
  71.     ' la fonction y  place donc les options en sortie.
  72.     ' Debug.Print Hex(lngFlags)
  73. End Function
  74. Function GetOpenFile(Optional varDirectory As Variant, _
  75.     Optional varTitleForDialog As Variant) As Variant
  76. ' Un exemple pour obtenir une base de données Access.
  77. Dim strFilter As String
  78. Dim lngFlags As Long
  79. Dim varFileName As Variant
  80. ' On désire que le fichier existe déjà,
  81. ' on ne veut pas changer de répertoire, en sortie
  82. ' et on n'affiche pas la mention "lecture seule"
  83. ' qui ne fait qu'embrouiller les gens
  84.     lngFlags = ahtOFN_FILEMUSTEXIST Or _
  85.                 ahtOFN_HIDEREADONLY Or ahtOFN_NOCHANGEDIR
  86.     If IsMissing(varDirectory) Then
  87.         varDirectory = ""
  88.     End If
  89.     If IsMissing(varTitleForDialog) Then
  90.         varTitleForDialog = ""
  91.     End If
  92.     ' Définir les filtres et utiliser  "c"
  93.     ' Copier cette ligne pour ajouter
  94.     ' d'autres filtres.
  95.     strFilter = ahtAddFilterItem(strFilter, _
  96.                 "Access (*.mdb)", "*.MDB;*.MDA" )
  97.     ' Et maintenant, obtenir le nom du fichier.
  98.     varFileName = ahtCommonFileOpenSave( _
  99.                     OpenFile:=True, _
  100.                     InitialDir:=varDirectory, _
  101.                     Filter:=strFilter, _
  102.                     Flags:=lngFlags, _
  103.                     DialogTitle:=varTitleForDialog)
  104.     If Not IsNull(varFileName) Then
  105.         varFileName = TrimNull(varFileName)
  106.     End If
  107.     GetOpenFile = varFileName
  108. End Function
  109. Function ahtCommonFileOpenSave( _
  110.             Optional ByRef Flags As Variant, _
  111.             Optional ByVal InitialDir As Variant, _
  112.             Optional ByVal Filter As Variant, _
  113.             Optional ByVal FilterIndex As Variant, _
  114.             Optional ByVal DefaultExt As Variant, _
  115.             Optional ByVal FileName As Variant, _
  116.             Optional ByVal DialogTitle As Variant, _
  117.             Optional ByVal hwnd As Variant, _
  118.             Optional ByVal OpenFile As Variant) As Variant
  119. 'Point d'entrée pour le contrôle commun
  120. ' "file open/save dialog". Les paramètres sont
  121. ' listés par après, et sont tous optionels.
  122. '
  123. ' *In:
  124. ' Flags: un ou plusieurs constantes de  ahtOFN_* constants, unie par des OR
  125. ' InitialDir: le répertoire présenté à l'usager
  126. ' Filter: une série de filtres pour les fichiers; utiliser
  127. '                           AddFilterItem. Voir l'exemple.
  128. ' FilterIndex: Index, base 1, fournissant le filtre par défaut
  129. '                           (1, si non spécifié)
  130. ' DefaultExt: Extension à utiliser si l'usager n'en entre pas.
  131. '                           Seulement pour les sauvegardes.
  132. ' FileName: Valeur par défaut pour le nom du fichier.
  133. ' DialogTitle: Titre dans la barre titre du formulaire.
  134. ' hWnd: handle Win32 du parent de ce dialogue
  135. ' OpenFile: Booléen(True=Open File/False=Save As)
  136. ' *Out:
  137. ' Return Value: Soit Null, soit le nom choisi
  138. Dim OFN As tagOPENFILENAME
  139. Dim strFileName As String
  140. Dim strFileTitle As String
  141. Dim fResult As Boolean
  142.     ' Fournir le caption (étiquette) du titre.
  143.     If IsMissing(InitialDir) Then InitialDir = CurDir
  144.     If IsMissing(Filter) Then Filter = ""
  145.     If IsMissing(FilterIndex) Then FilterIndex = 1
  146.     If IsMissing(Flags) Then Flags = 0&
  147.     If IsMissing(DefaultExt) Then DefaultExt = ""
  148.     If IsMissing(FileName) Then FileName = ""
  149.     If IsMissing(DialogTitle) Then DialogTitle = ""
  150.     If IsMissing(hwnd) Then hwnd = Application.hWndAccessApp
  151.     If IsMissing(OpenFile) Then OpenFile = True
  152.     ' Créer une chaîne pour recevoir le résultat.
  153.     strFileName = Left(FileName & String(256, 0), 256)
  154.     strFileTitle = String(256, 0)
  155.     ' Initialiser la structure avant d'appeler la fonction
  156.     With OFN
  157.         .lStructSize = Len(OFN)
  158.         .hwndOwner = hwnd
  159.         .strFilter = Filter
  160.         .nFilterIndex = FilterIndex
  161.         .strFile = strFileName
  162.         .nMaxFile = Len(strFileName)
  163.         .strFileTitle = strFileTitle
  164.         .nMaxFileTitle = Len(strFileTitle)
  165.         .strTitle = DialogTitle
  166.         .Flags = Flags
  167.         .strDefExt = DefaultExt
  168.         .strInitialDir = InitialDir
  169.         ' On ne pense pas que quelqu'un veut vraiment utiliser
  170.         ' ces options.
  171.         .hInstance = 0
  172.         .strCustomFilter = ""
  173.         .nMaxCustFilter = 0
  174.         .lpfnHook = 0
  175.         ' Pour  NT 4.0
  176.         .strCustomFilter = String(255, 0)
  177.         .nMaxCustFilter = 255
  178.     End With
  179.     ' Transmettre la structure de données au
  180.     ' Windows API qui, à son tour, affichera
  181.     ' le formulaire "Open/Save As".
  182.     If OpenFile Then
  183.         fResult = aht_apiGetOpenFileName(OFN)
  184.     Else
  185.         fResult = aht_apiGetSaveFileName(OFN)
  186.     End If
  187.     ' La fonction retourne le nom dans le membre strFileTitle
  188.     ' de la structure. Il nous faut écrire du code pour
  189.     ' retrouver ce qui nous intéresse.
  190.     If fResult Then
  191.         ' Vous pouvez vérifier les membres de la structure
  192.         ' pour obtenir plus d'information sur le fichier choisi.
  193.         ' Dans cet exemple, si vous avez fourni un argument pour
  194.         ' les options, on vous retourne les indicateurs (flags) dans
  195.         ' cette même variable.
  196.         If Not IsMissing(Flags) Then Flags = OFN.Flags
  197.         ahtCommonFileOpenSave = TrimNull(OFN.strFile)
  198.     Else
  199.         ahtCommonFileOpenSave = vbNullString
  200.     End If
  201. End Function
  202. Function ahtAddFilterItem(strFilter As String, _
  203.     StrDescription As String, Optional varItem As Variant) As String
  204. ' Ajoute un nouvel ensemble de données formant un nouveau filtre.
  205. ' Par exemple, aux filtres existants, ajouter une  description,
  206. ' (tel  "Databases" ), un caractère  null, la grille passe-partout
  207. ' (tel "*.mdb;*.mda" ) et un dernier caractère null.
  208.     If IsMissing(varItem) Then varItem = "*.*"
  209.     ahtAddFilterItem = strFilter & _
  210.                 StrDescription & vbNullChar & _
  211.                 varItem & vbNullChar
  212. End Function
  213. Private Function TrimNull(ByVal strItem As String) As String
  214. Dim intPos As Integer
  215.     intPos = InStr(strItem, vbNullChar)
  216.     If intPos > 0 Then
  217.         TrimNull = Left(strItem, intPos - 1)
  218.     Else
  219.         TrimNull = strItem
  220.     End If
  221. End Function


---------------
« Lorsque le bûcheron pénétra dans la forêt avec sa hache, les arbres se dirent : ne nous inquiétons pas, le manche est des nôtres. » | Gérez votre collection de BD en ligne !
Reply

Marsh Posté le 21-07-2003 à 08:44:11    

Je crois que je vais l'avoir dur parce que j'ai un peu rien compris au code mais je vais l'essayer de l'intégrer et voir ce que ca donne ....
 
merci

Reply

Marsh Posté le 21-07-2003 à 19:23:29    

En toute honnêteté, j'ai pas cherché à le comprendre non plus  :lol:

Reply

Marsh Posté le 22-07-2003 à 09:57:32    

Bon, je comprends pas comment l'utiliser ...
 
J'ai un champs de type Zone de texte nommé ZT_Chemin.
Je voudrais que ca m'ouvre une fenetre de type parcourir lors d'un click sur le bouton B_Parcourir.
 
Et que ca me renvois quand je cliques sur OK de cette fenetre le chemin dans la ZT_Chemin.
 
Y'a quoi à modifier pliz ?
 :ange:  :ange:

Reply

Marsh Posté le 25-07-2003 à 12:02:58    

bah simplement :
 

Code :
  1. Private sub ZT_Chemin_On_click()
  2. dim strFilePath as string
  3. strFilePath = openit()
  4. 'Là, tu met tes check si tu veux tester ce que l'utilisateur a choisi
  5. '
  6. '
  7. Me.ZT_Chemin = strFilePath
  8. End sub


---------------
« Lorsque le bûcheron pénétra dans la forêt avec sa hache, les arbres se dirent : ne nous inquiétons pas, le manche est des nôtres. » | Gérez votre collection de BD en ligne !
Reply

Sujets relatifs:

Leave a Replay

Make sure you enter the(*)required information where indicate.HTML code is not allowed