1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74
| Public Function OuvrirUnFichier(Handle As Long, _
Titre As String, _
TypeRetour As Byte, _
Optional TitreFiltre As String, _
Optional TypeFichier As String, _
Optional RepParDefaut As String) As String
' OuvrirUnFichier est la fonction à utiliser dans votre formulaire pour ouvrir _
' la boîte de dialogue de sélection d'un fichier.
' Explication des paramètres
' Handle = le handle de la fenêtre
' Titre = titre de la boîte de dialogue
' TypeRetour (définit la valeur, de type String, renvoyée par la fonction)
' 1 = chemin complet + nom du fichier
' 2 = nom fichier seulement
' TitreFiltre = titre du filtre
' Exemple: fichier Access
' N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
' TypeFichier = extention du fichier (sans le .)
' Exemple: MDB
' N'utilisez pas cet argument si vous ne voulez spécifier aucun filtre
' RepParDefaut = répertoire d'ouverture par défaut
' Exemple: C:\windows\system32
' Si vous laissez l'argument vide, par défaut il se place dans le répertoire de votre application
Dim StructFile As OPENFILENAME
Dim sFiltre As String
Dim fichierchoisi, extfichier As String
Dim appWD As Object
' Construction du filtre en fonction des arguments spécifiés
sFiltre = sFiltre & "Tous (*.*)" & Chr$(0) & "*.*" & Chr$(0)
' Configuration de la boîte de dialogue
With StructFile
.lStructSize = Len(StructFile) ' Initialisation de la grosseur de la structure
.hwndOwner = Handle ' Identification du handle de la fenêtre
.lpstrFilter = sFiltre ' Application du filtre
.lpstrFile = String$(254, vbNullChar) ' Initialisation du fichier '0' x 254
.nMaxFile = 254 ' Taille maximale du fichier
.lpstrFileTitle = String$(254, vbNullChar) ' Initialisation du nom du fichier '0' x 254
.nMaxFileTitle = 254 ' Taille maximale du nom du fichier
.lpstrTitle = Titre ' Titre de la boîte de dialogue
.flags = OFN_HIDEREADONLY ' Option de la boite de dialogue
.lpstrInitialDir = "E:\dropbox\access"
End With
If (GetOpenFileName(StructFile)) Then ' Si un fichier est sélectionné
fichierchoisi = Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar)))
extfichier = Right$(fichierchoisi, 4)
MsgBox extfichier, vbDefaultButton1, "Control"
If extfichier = "doc" Or extfichier = "docx" Or extfichier = "txt" Then
Set appWD = CreateObject("Word.Application")
With appWD
.Visible = True
.Documents.Open Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar)))
.WindowState = wdWindowStateMaximize
.Activate
End With
ElseIf extfichier = "xls" Or extfichier = "xla" Or extfichier = "xlsm" Or extfichier = " xlsx" Then
Set appWD = CreateObject("Excel.Application")
With appWD
.Visible = True
.Documents.Add Template:=Trim$(Left(StructFile.lpstrFile, InStr(1, StructFile.lpstrFile, vbNullChar))), NewTemplate:=False, DocumentType:=0
.WindowState = wdWindowStateMaximize
.Activate
End With
Else
MsgBox "Fichier non supporté, veuillez utiliser l'explorateur de Windows", vbCritical, "Message utilisateur"
End If
Else
Exit Function
End If
End Function |
Partager