Boite de dialogue pour choisir un Fichier

Commenter

Contenu du snippet 

Private Const MAX_PATH = 260
Private Const OFN_ALLOWMULTISELECT = &H200
Private Const OFN_EXPLORER = &H80000
Private Const OFN_FILEMUSTEXIST = &H1000
Private Const OFN_HIDEREADONLY = &H4
Private Const OFN_READONLY = &H1
Private Type OpenFileName
  lStructSize As Long
  hWndOwner As Long
  hInstance As Long
  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 Long
  lpfnHook As Long
  lpTemplateName As String
End Type
Private Declare Function MultiByteToWideChar Lib "kernel32" (ByVal CodePage As Long, ByVal dwFlags As Long, ByVal lpMultiByteStr As String, ByVal cchMultiByte As Long, ByVal lpWideCharStr As String, ByVal cchWideChar As Long) As Long
Private Declare Function GetOpenFileNameW Lib "comdlg32.dll" (pOpenfilename As OpenFileName) As Boolean
Private Function GetOpenFileName(ByVal Title As String, _
                                 Files() As String, _
                                 Optional ByVal Filter As String = vbNullString, _
                                 Optional ByVal FilterIndex As Long = 0, _
                                 Optional ByVal InitialDir As String = vbNullString, _
                                 Optional ByVal MultiSelect As Boolean = False, _
                                 Optional ByVal FileMustExist As Boolean = False, _
                                 Optional ByVal HideReadOnly As Boolean = False, _
                                 Optional ByRef OpenReadOnly As Boolean = False, _
                                 Optional ByVal hWndOwner As Long = 0 _
                                 ) As Boolean
  Dim op As OpenFileName
  op.lStructSize = LenB(op)
  op.hWndOwner = hWndOwner
  op.hInstance = App.hInstance
  op.lpstrTitle = String$(256, 0)
  Call MultiByteToWideChar(0, 0, Title, Len(Title), op.lpstrTitle, 256)
  op.lpstrInitialDir = String$(MAX_PATH, 0)
  Call MultiByteToWideChar(0, 0, InitialDir, Len(InitialDir), op.lpstrInitialDir, MAX_PATH)
  op.lpstrFilter = String$(256, 0)
  Filter = VBA.Replace(Filter, "|", ChrW$(0))
  Call MultiByteToWideChar(0, 0, Filter, Len(Filter), op.lpstrFilter, MAX_PATH)
  op.nFilterIndex = FilterIndex + 1
  op.nMaxFile = 4096
  op.lpstrFile = String$(op.nMaxFile, 0)
  If MultiSelect Then op.flags = op.flags Or OFN_ALLOWMULTISELECT Or OFN_EXPLORER
  If FileMustExist Then op.flags = op.flags Or OFN_FILEMUSTEXIST
  If HideReadOnly Then op.flags = op.flags Or OFN_HIDEREADONLY
  If OpenReadOnly Then op.flags = op.flags Or OFN_READONLY
  If GetOpenFileNameW(op) Then
    Dim OpenFileName As String
    OpenFileName = VBA.StrConv(op.lpstrFile, vbFromUnicode)
    Erase Files
    If MultiSelect Then
      Dim BufferFiles() As String, i As Integer
      BufferFiles = VBA.Split(OpenFileName, ChrW$(0))
      OpenFileName = vbNullString
      For i = 0 To UBound(BufferFiles)
        If BufferFiles(i) = vbNullString Then Exit For
        If i = 0 And BufferFiles(1) = vbNullString Then
          OpenFileName = BufferFiles(0)
          Exit For
        ElseIf i > 0 Then
          If Not OpenFileName = vbNullString Then
            OpenFileName = OpenFileName & ChrW$(0) & BufferFiles(0) & BufferFiles(i)
          Else
            OpenFileName = BufferFiles(0) & BufferFiles(i)
          End If
        Else
          If Not VBA.Right$(BufferFiles(0), 1) = "\" Then BufferFiles(0) = BufferFiles(0) & "\"
        End If
      Next i
      Files = VBA.Split(OpenFileName, ChrW$(0))
    Else
      ReDim Files(0)
      Files(0) = VBA.Left$(OpenFileName, VBA.InStr(1, OpenFileName, ChrW$(0)) - 1)
    End If
    OpenReadOnly = op.flags And OFN_READONLY
    GetOpenFileName = True
  Else
    GetOpenFileName = False
  End If
End Function
'Exemple d'utilisation :
Dim Files() As String
If GetOpenFileName("Chosir plusieur Fichiers", Files, "txt files (*.txt)|*.txt|All files (*.*)|*.*", 1&, "C:\", True, True) Then
  ' Ok
Else
  ' Annuler
End If

Compatibilité : VB6

Disponible dans d'autres langages :

A voir également

S'inscrire maintenant

Vous n'êtes pas encore membre ?

inscrivez-vous, c'est gratuit et ça prend moins d'une minute !

Les membres obtiennent plus de réponses que les utilisateurs anonymes.

Le fait d'être membre vous permet d'avoir un suivi détaillé de vos demandes et codes sources.

Le fait d'être membre vous permet d'avoir des options supplémentaires.

Du même auteur (us_30)