Recherche
Les mémos
-
Tables
- · Annuler la suppression
- · Attacher feuilles Excel
- · Cacher une table
- · Concaténer une colonne
- · Créer une table
- · Dernière modification
- · Index composé
- · Limiter les enregistrements
- · Liste des champs
- · Modifier valeur de champ
- · Où est la table
- · Peupler une table de Logs
- · Renuméroter un champ
- · Réattacher les liens
- · Réattacher les liens locaux
- · Scinder un champ
- · Supprimer les tables liées
- · Trouver la différence
-
Formulaires
- · Afficher les derniers
- · Ajout à liste modifiable
- · Ajouter enregistrement
- · Barre de progression
- · Click ou double-click
- · Confirmer l'enregistrement
- · Copier - Coller
- · Défilement de la roulette
- · Exporter un graphique
- · Filtres personnalisés
- · Identifiants d'un Form continu
- · Importer les formulaires
- · Langue utilisateur
- · Limiter la saisie
- · Mémoriser une valeur
- · No enregistrement
- · Ouvert en normal
- · Position des formulaires
- · Recopier dernière valeur
- · Scroll automatique
- · Switch Modal
- · Tri manuel dans form
- · Tri personnalisé
- · Verrouillage de formulaire
- · Vérifier les saisies
-
Automation
-
Administration
- · Chemin de la base
- · Déconnecter utilisateur
- · Désactiver le Shift
- · Désactiver le Shift(2)
- · Liste des références
- · Liste des utilisateurs
- · Lister les applications
- · Mode exclusif
- · Nom d'utilisateur
- · Nom de l'ordinateur
- · Paramètres régionaux
- · Propriétés de la base
- · Sauvegarde journalière
- · Sauvegarde mensuelle
- · Shell and Wait
- · Version de Windows
-
Envoyer un mail
-
Outlook
- · Ajouter des contacts
- · Déplacer les messages
- · Enregistrer pièces jointes
- · Est ouvert ?
- · Exporter les contacts
- · Exporter les rendez-vous
- · Importer les messages
- · Integrer un état
- · Lire les contacts
- · Lire les rendez-vous
- · Lister les dossiers
- · Lister les tâches
- · SendMail (MAPI)
- · SendMail Automation
-
Dates - Heures
-
Fichiers
- · Compter les dossiers
- · Créer un dossier
- · Générer fichier TXT
- · Importer fichier TXT
- · Le dossier existe ?
- · Le fichier existe ?
- · Lister les fichiers
- · Lister les fichiers (2007)
- · Lister les sous-dossiers
- · Rechercher un répertoire
- · Répertoire dans table
- · Supprimer ReadOnly
- · Sélection de dossier
- · Sélection de dossier (API)
- Sélection de fichiers
- · Sélection fichier (MOL)
-
Références
Je débute...
-
La normalisation
-
VBA
Visites
1259001 visiteurs
3 visiteurs en ligne
Nous contacter
Contact
Sélection de fichiers
Parcourir et Sélectionner un ou plusieurs fichiers (API)
Sélectionner et retourner le chemin de un ou plusieurs fichiers séparés par un point-virgule, dans une boîte de dialogue Fichier Ouvrir.
'/ '/ A placer dans la partie déclarative '/ Option Compare Database Option Explicit Public Type OpenFileName lStructSize As Long hwndOwner As Long Instance As Long lpstrFilter As String lpstrCustomFilter As String nMaxCustomFilter 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 Long lpfnHook As Long lpTemplateName As String End Type Public Declare Function GetOpenFileName Lib "comdlg32.dll" _ Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long Public Const OFN_AllowMultiSelect = &H200 Public Const OFN_CreatePrompt = &H2000 Public Const OFN_EnableHook = &H20 Public Const OFN_EnableTemplate = &H40 Public Const OFN_EnableTemplateHandle = &H80 Public Const OFN_EXPLORER = &H80000 Public Const OFN_ExtensionDifferent = &H400 Public Const OFN_FileMustExist = &H1000 Public Const OFN_HideReadOnly = &H4 Public Const OFN_LongNames = &H200000 Public Const OFN_NoChangeDir = &H8 Public Const OFN_NoDeReferenceLinks = &H100000 Public Const OFN_NoLongNames = &H40000 Public Const OFN_NoNetWorkButton = &H20000 Public Const OFN_NoReadOnlyReturn = &H8000 Public Const OFN_NoTestFileCreate = &H10000 Public Const OFN_NoValiDate = &H100 Public Const OFN_OverWritePrompt = &H2 Public Const OFN_PathMustExist = &H800 Public Const OFN_ReadOnly = &H1 Public Const OFN_ShareAware = &H4000 Public Const OFN_ShareFallThrough = 2 Public Const OFN_ShareNoWarn = 1 Public Const OFN_ShareWarn = 0 Public Const OFN_ShowHelp = &H10 Global Dialogue As OpenFileName Public strFiltre As String Public strFile As String Public strNomFile As String Public RetVal As Long
La fonction :
Public Function fOpenFile(Optional strTitle As Variant, _ Optional strInitialDir As Variant, _ Optional MultiSelect As Boolean = False) _ As String If IsMissing(strTitle) Then strTitle = "Ouvrir..." End If If IsMissing(strInitialDir) Then strInitialDir = CurDir End If fOpenFile = "" strFiltre = "Fichiers Word" & Chr$(0) & "*.doc;*txt" & Chr$(0) & _ "Fichiers Access" & Chr$(0) & "*.mdb" & Chr$(0) & _ "Fichiers Excel" & Chr$(0) & "*.xls" & Chr$(0) & _ "Tous les fichiers" & Chr$(0) & "*.*" With Dialogue .lStructSize = Len(Dialogue) .lpstrFilter = strFiltre .lpstrFile = Space(254) .nMaxFile = 255 .lpstrFileTitle = Space(254) .nMaxFileTitle = 255 .lpstrInitialDir = strInitialDir .lpstrTitle = strTitle If MultiSelect = False Then .flags = OFN_FileMustExist + _ OFN_HideReadOnly + _ OFN_PathMustExist Else .flags = OFN_FileMustExist + _ OFN_HideReadOnly + _ OFN_PathMustExist + _ OFN_AllowMultiSelect + _ OFN_LongNames + _ OFN_EXPLORER End If End With RetVal = GetOpenFileName(Dialogue) If RetVal >= 1 Then fOpenFile = fMultiSelect(Dialogue.lpstrFile) Else fOpenFile = "" Exit Function End If End Function
La fonction fMultiSelect :
Function fMultiSelect(ByVal strItem As String) As String Dim strTemp As String Dim pos As Integer Dim TabFile() As String Dim no As Integer no = -1 strTemp = strItem pos = InStr(1, strTemp, vbNullChar, vbBinaryCompare) Do While pos > 1 If Left$(strTemp, pos - 1) <> "" Then no = no + 1 ReDim Preserve TabFile(no) TabFile(no) = Left$(strTemp, pos - 1) strTemp = Right(strTemp, Len(strTemp) - Len(TabFile(no)) - 1) pos = InStr(1, strTemp, vbNullChar, vbBinaryCompare) End If Loop If Len(TabFile(0)) = 3 Then TabFile(0) = Left(TabFile(0), 2) End If If UBound(TabFile) = 0 Then fMultiSelect = TabFile(0) Else For no = LBound(TabFile()) + 1 To UBound(TabFile) If fMultiSelect = "" Then fMultiSelect = TabFile(0) & "" & TabFile(no) Else fMultiSelect = fMultiSelect & ";" & TabFile(0) & "" & TabFile(no) End If Next no End If End Function
Catégorie : Les mémos - Fichiers
Page lue 8529 fois
Page lue 8529 fois