Coder bouton ouvrir commondialog

Commenter

Contenu du snippet

J'avais posté un message sur le forum : Je voulais pouvoir ouvrir un fichier en cliquant sur le bouton ouvrir mais je ne savais pas comment le coder (en VBA). L'autre solution était de faire un clic droit sur le fichier et selectionné ouvir (là ça marche) mais c'était moins pratique pour l'utilisateur.
Donc :
- Ouvrez un nouveau projet.
- Sur form1, placez un bouton (Command1) et le controle CommonDialog (CommonDialog1).
- Collez ce code ( Code pour VB. un pett changement expliqué plus bas si c'est pour du VBA)

Ce code n'est pas de moi, mais de la gentille personne qui m'a repondu (pas sur VBFrance).

Source / Exemple : 


Option Explicit
Private Declare Function FindExecutable Lib "shell32.dll" Alias "FindExecutableA" _
(ByVal lpFile As String, ByVal lpDirectory As String, _
ByVal lpResult As String) As Long

Private Sub Command1_Click()
Dim sFile As String
Dim sPath As String
Dim lPosition As Long
Dim sPathEXE As String
With CommonDialog1
.Filter = "Tous (*.*)|*.*"
.FileName = ""
.ShowOpen
sFile = .FileName
End With
If sFile <> "" Then
'Cherche la position du dernier "\"

'Attention la ligne qui suit ne marche pas en VBA, il faut mettre a la place :
'sTitle = Comondialog1.FileTitle
'lPosition = len (sFile) - len(sTitle)
'au lieu de :
lPosition = InStrRev(sFile, "\", -1)

'Extrait le chemin
sPath = Left(sFile, lPosition - 1)
'Extrait le nom du fichier
sFile = Mid(sFile, lPosition + 1)
'Recherche le programme associé à ce fichier
sPathEXE = FichierAssocie(sFile, sPath)
If sPathEXE <> "" Then
'Appelle le programme et ouvre le fichier
Shell sPathEXE & " " & sPath & "\" & sFile, vbNormalFocus
Else
MsgBox "Il n'y a aucun programme associé au fichier " & sFile & ".", vbExclamation
End If
End If
End Sub

Private Function FichierAssocie(stFichier As String, stChemin As String) As String
' Retour l'application associé au fichier passé en argument.
Dim stRep As String
Dim lgRep As Long
' Initialisation du buffer de retour
stRep = Space$(250)
' Appel à la fonction
lgRep = FindExecutable(stFichier, stChemin, stRep)
' Traitement de la valeur de retour
stRep = Left$(stRep, InStr(1, stRep, vbNullChar) - 1)
' Retourne le résultat
FichierAssocie = stRep
End Function

Conclusion :


N'hésitez pas à laisser un comentaire.

Stoomm.

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.