-----Message d'origine-----
Salut,
A mon avis t'as plus simple :
essai ca dans un module :
Sub ouvr()
Dim FichOuv As Variant
'ici tu indiques le chemin a suivre (il peut y en avoir
plusieurs avec des
conditions if....then...else...end if)
ChDir "C:WINDOWSDESKTOP"
ChDrive "C"
'
***********************************************************
' Set up list of file filters
'ici tu peux mettre les extensions des fichiers a trouver
Filt = "Fichier Mic (*.mic),*.mic,"
'
***********************************************************
' Set the dialog box caption
Title = "Selectionnez un Fichier (Explan) a
Importer : "
' Get the file name
Filename = Application.GetOpenFilename
(FileFilter:=Filt, Title:=Title)
' Exit if dialog box canceled
If Filename = False Then
'si tu clicks sur cancel/annule tu peux egalement un
message du style pas de
fichier selectionne
Exit Sub
End If
End Sub
@+
Michel.
"Sylvain" wrote in
message
news:124c01c3e010$8aaa6ff0$
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Salut,
A mon avis t'as plus simple :
essai ca dans un module :
Sub ouvr()
Dim FichOuv As Variant
'ici tu indiques le chemin a suivre (il peut y en avoir
plusieurs avec des
conditions if....then...else...end if)
ChDir "C:WINDOWSDESKTOP"
ChDrive "C"
'
***********************************************************
' Set up list of file filters
'ici tu peux mettre les extensions des fichiers a trouver
Filt = "Fichier Mic (*.mic),*.mic,"
'
***********************************************************
' Set the dialog box caption
Title = "Selectionnez un Fichier (Explan) a
Importer : "
' Get the file name
Filename = Application.GetOpenFilename
(FileFilter:=Filt, Title:=Title)
' Exit if dialog box canceled
If Filename = False Then
'si tu clicks sur cancel/annule tu peux egalement un
message du style pas de
fichier selectionne
Exit Sub
End If
End Sub
@+
Michel.
"Sylvain" <Sylvain@discussions.microsoft.com> wrote in
message
news:124c01c3e010$8aaa6ff0$a301280a@phx.gbl...
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Salut,
A mon avis t'as plus simple :
essai ca dans un module :
Sub ouvr()
Dim FichOuv As Variant
'ici tu indiques le chemin a suivre (il peut y en avoir
plusieurs avec des
conditions if....then...else...end if)
ChDir "C:WINDOWSDESKTOP"
ChDrive "C"
'
***********************************************************
' Set up list of file filters
'ici tu peux mettre les extensions des fichiers a trouver
Filt = "Fichier Mic (*.mic),*.mic,"
'
***********************************************************
' Set the dialog box caption
Title = "Selectionnez un Fichier (Explan) a
Importer : "
' Get the file name
Filename = Application.GetOpenFilename
(FileFilter:=Filt, Title:=Title)
' Exit if dialog box canceled
If Filename = False Then
'si tu clicks sur cancel/annule tu peux egalement un
message du style pas de
fichier selectionne
Exit Sub
End If
End Sub
@+
Michel.
"Sylvain" wrote in
message
news:124c01c3e010$8aaa6ff0$
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO) As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré etses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend dela ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophedevant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré et
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend de
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophe
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$a301280a@phx.gbl...
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré etses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend dela ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophedevant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré etses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend dela ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophedevant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain
-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré et
ses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend de
la ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophe
devant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.
'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""
ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"
'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" <Sylvain@discussions.microsoft.com> a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$a301280a@phx.gbl...
Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
-----Message d'origine-----
Bonjour Sylvain,
Voici une façon de faire en provenance de Microsoft,
modifié par Denis Pasquier et que j'ai moi-même modifier
pour obtenir ce que tu désires....
Dans la procédure Test() , tu retrouves cette ligne de
code : Tu dois définir ces 2 paramètres :
A ) Le répertoire sur lequel tu désires
ouvrir "L'explorateur" : "C:excel"
B ) Tu peux choisir un type de fichier que tu veux voir
s'afficher : ".xls" , pour pouvoir les visionner
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
à copier dans un module Standard, La section API doit se
retrouver dans le haut du module !
************************************
Option Explicit
'Microsoft Developer Support.
'adaptation Denis Pasquier
'Code Example
'Ouverture d'un type de fichier
'--------------------------------
Declare Function GetOpenFileName Lib "comdlg32.dll" _
Alias "GetOpenFileNameA" (pOpenfilename As
OPENFILENAME) As Long
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 Function SelectAFile(Rep As String, Optional
filtre As String = "*.*") As String
Dim OpenFile As OPENFILENAME, lReturn As Long, sFilter As
String
OpenFile.lStructSize = Len(OpenFile)
sFilter = "Tous les fichiers (" & filtre & ")" & Chr(0)
& filtre & Chr(0)
With OpenFile
.lpstrFilter = sFilter
.nFilterIndex = 1
.lpstrFile = String(257, 0)
.nMaxFile = Len(OpenFile.lpstrFile) - 1
.lpstrFileTitle = OpenFile.lpstrFile
.nMaxFileTitle = OpenFile.nMaxFile
.lpstrInitialDir = Rep
.lpstrTitle = "Ouvrir"
.flags = 0
End With
lReturn = GetOpenFileName(OpenFile)
If lReturn = 0 Then
SelectAFile = "erann"
Else
SelectAFile = Trim(Left(OpenFile.lpstrFile, _
InStr(1, OpenFile.lpstrFile, Chr(0)) - 1))
End If
End Function
'---------------------------------
Sub test()
'Denis pasquier
Dim Fichier_a_ouvrir As Variant
Fichier_a_ouvrir = SelectAFile("C:excel", "*.xls")
If Fichier_a_ouvrir <> "erann" Then
MsgBox Fichier_a_ouvrir
End If
End Sub
'---------------------------------
************************************
Salutations!
"Sylvain" a écrit
dans le message de news:1b4101c3e01f$317ab840
Merci beaucoup pour cette fonction.
Peut-on changer un paramétre pour pouvoir remonter plus
dans l'arborescence que le chemin spécifié ?
Merci
Sylvain-----Message d'origine-----
Bonjour Sylvain,
Tu peux essayer ceci :
'affiche une fenêtre type explorateur à partir de
laquelle il est possible d'afficher seulement soit le
répertoire désiré etses sous-répertoires sans les fichiers ou soit un
répertoire désiré, ses sous-répertoires et leurs fichiers.
Cela dépend dela ligne de code que l'on active dans la fonction
ChoixDossier(chemin). Pour ce faire, il s'agit de placer
une apostrophedevant la ligne de code pour la désactiver ou d'enlever
l'apostrophe pour l'activer.
'----------------------------------------
Function ChoixDossier(Chemin)
Dim objShell, objFolder
MSG = "Voici votre répertoire:"
Set objShell = CreateObject("Shell.Application")
'Cette ligne affiche répertoire et fichiers du
répertoire.'Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H4000, Chemin)
'Cette Ligne = pour afficher seulement les
répertoires
Set objFolder = objShell.BrowseForFolder(&H0&, MSG,
&H1&, Chemin)On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName
(objFolder.Title).path & ""ChoixDossier = Chemin
End Function
'-----------------------------------------
'Et pour ouvrir le Browser ayant comme répertoire
racine "Mes documents"'on peut utiliser la procédure suivante .
'------------------------------------------
Sub OuvrirRépertoire()
Dim CheminEtFichier As String
CheminEtFichier = ChoixDossier("c:Mes documents")
End Sub
'------------------------------------------
Salutations!
"Sylvain" a écrit
dans le message de news:124c01c3e010$8aaa6ff0
$Bonjour,
J'utilise la fonction GetDirectory() ci dessous récuperée
sur excelabo pour afficher un fenetre de choix d'un
répertoire.
Comment faire pour prépositionner la sélection sur un
sous
répertoire au lieu de la position par défault qui est
le "poste de travail"
Merci par avance
Sylvain
Public Type BROWSEINFO
hOwner As Long
pidlRoot As Long
pszDisplayName As String
lpszTitle As String
ulFlags As Long
lpfn As Long
lParam As Long
iImage As Long
End Type
'declarations API 32-bit
Declare Function SHGetPathFromIDList Lib "shell32.dll" _
Alias "SHGetPathFromIDListA" (ByVal pidl As Long, ByVal
pszPath As String) As Long
Declare Function SHBrowseForFolder Lib "shell32.dll" _
Alias "SHBrowseForFolderA" (lpBrowseInfo As BROWSEINFO)
As
Long
Function GetDirectory(Optional MSG) As String
Dim bInfo As BROWSEINFO
Dim path As String
Dim r As Long, X As Long, pos As Integer
bInfo.pidlRoot = 0&
If IsMissing(MSG) Then
bInfo.lpszTitle = "Choisissez le dossier de stockage
du document :"
Else
bInfo.lpszTitle = MSG
End If
bInfo.ulFlags = &H1
X = SHBrowseForFolder(bInfo)
path = Space$(512)
r = SHGetPathFromIDList(ByVal X, ByVal path)
If r Then
pos = InStr(path, Chr$(0))
GetDirectory = Left(path, pos - 1)
Dossier = GetDirectory
Else
GetDirectory = ""
Dossier = ""
End If
End Function
.
.
