Forum |  HardWare.fr | News | Articles | PC | S'identifier | S'inscrire | Shop Recherche
2441 connectés 

  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Bouton parcourir en VBA (pour Access)

 
 


 Mot :   Pseudo :  
 
Bas de page
Auteur Sujet :

Bouton parcourir en VBA (pour Access)

n°459943
Worldofdad​a
Posté le 17-07-2003 à 10:08:25  profilanswer
 

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

mood
Publicité
Posté le 17-07-2003 à 10:08:25  profilanswer
 

n°461693
latruffe
Bdovore
Posté le 18-07-2003 à 15:48:51  profilanswer
 

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

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

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

n°463790
latruffe
Bdovore
Posté le 21-07-2003 à 19:23:29  profilanswer
 

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

n°464327
Worldofdad​a
Posté le 22-07-2003 à 09:57:32  profilanswer
 

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:

n°467617
latruffe
Bdovore
Posté le 25-07-2003 à 12:02:58  profilanswer
 

bah simplement :
 

Code :
  1. Private sub ZT_Chemin_On_click()
  2. dim strFilePath as string
  4. strFilePath = openit()
  5. 'Là, tu met tes check si tu veux tester ce que l'utilisateur a choisi
  6. '
  7. '
  9. Me.ZT_Chemin = strFilePath
  11. 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 !

Aller à :
Ajouter une réponse
  FORUM HardWare.fr
  Programmation
  VB/VBA/VBS

  Bouton parcourir en VBA (pour Access)

 

Sujets relatifs
de l'AS400 (fichier .tto) vers VBA (Excel)Access, tu me soules !!
Temps de transfert Base Access ...SQL serveur[VC++] barre de progression et bouton annuler
VBA: scinder un label?Probleme avec la propriété FormulaArray sous VBA (Excel)
[VBA, access] mettre autre chose qu'un fichier office en 'object'[PHP/ACCESS] requete UPDATE ne passe pas alors que INSERT et DELETE si
[C++\VBA] Communication C++ VBA 
Plus de sujets relatifs à : Bouton parcourir en VBA (pour Access)

Forum MesDiscussions.Net, Version 2010.2
(c) 2000-2011 Doctissimo
Page générée en 0.091 secondes

Copyright © 1997-2022 Hardware.fr SARL (Signaler un contenu illicite / Données personnelles) / Groupe LDLC / Shop HFR