[VBA] Sélection d'un fichier à partir d'une racine
2 réponses
HD
Bonjour,
Anciennement j'utilisai une macro pour sélectionner un fichier à partir
d'une racine...
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If
Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier (0) ou d'un fichier (1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
If objFolder.Title = "" Then
Chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function
Mon problème est que cette macro plante de manière quasiment systèmatique
dès que l'on sélectionne un fichier à la racine de la racine précisée...
J'ai alors un message "Erreur d'exécution '-2147024894 (80070002)': La
méthode 'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."
J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3... Le
problème se posait déja avec XP SP2. Je ne sais si cela vient de la version
d'Excel ou de la version Windows... Je n'ai pas de références manquantes...
Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre
auriez vous une macro équivalente fonctionnant sous de nombreuses
configurations (Excel et Windows) ?
Cette action est irreversible, confirmez la suppression du commentaire ?
Signaler le commentaire
Veuillez sélectionner un problème
Nudité
Violence
Harcèlement
Fraude
Vente illégale
Discours haineux
Terrorisme
Autre
Daniel.C
Bonjour. Comment fais-tu pour remonter "à la racine de la racine" ? Daniel
Bonjour,
Anciennement j'utilisai une macro pour sélectionner un fichier à partir d'une racine...
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0) Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
If SelType = 0 Then FlagChoix = &H1&: Msg = "Choisissez un dossier :" Else FlagChoix = &H4000&: Msg = "Choisissez un fichier :" End If
Set objShell = CreateObject("Shell.Application") 'le troisième paramètre permet de choisir 'la sélection d'un dossier (0) ou d'un fichier (1) 'le dernier paramètre permet de choisir le dossier racine Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine) On Error Resume Next Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & "" If objFolder.Title = "" Then Chemin = "" End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & "" End If ChoixDossierFichier = Chemin End Function
Mon problème est que cette macro plante de manière quasiment systèmatique dès que l'on sélectionne un fichier à la racine de la racine précisée... J'ai alors un message "Erreur d'exécution '-2147024894 (80070002)': La méthode 'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."
J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3... Le problème se posait déja avec XP SP2. Je ne sais si cela vient de la version d'Excel ou de la version Windows... Je n'ai pas de références manquantes...
Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre auriez vous une macro équivalente fonctionnant sous de nombreuses configurations (Excel et Windows) ?
Bonjour.
Comment fais-tu pour remonter "à la racine de la racine" ?
Daniel
Bonjour,
Anciennement j'utilisai une macro pour sélectionner un fichier à partir d'une
racine...
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0)
Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
If SelType = 0 Then
FlagChoix = &H1&: Msg = "Choisissez un dossier :"
Else
FlagChoix = &H4000&: Msg = "Choisissez un fichier :"
End If
Set objShell = CreateObject("Shell.Application")
'le troisième paramètre permet de choisir
'la sélection d'un dossier (0) ou d'un fichier (1)
'le dernier paramètre permet de choisir le dossier racine
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine)
On Error Resume Next
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
If objFolder.Title = "" Then
Chemin = ""
End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then
Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & ""
End If
ChoixDossierFichier = Chemin
End Function
Mon problème est que cette macro plante de manière quasiment systèmatique dès
que l'on sélectionne un fichier à la racine de la racine précisée... J'ai
alors un message "Erreur d'exécution '-2147024894 (80070002)': La méthode
'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."
J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3... Le
problème se posait déja avec XP SP2. Je ne sais si cela vient de la version
d'Excel ou de la version Windows... Je n'ai pas de références manquantes...
Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre
auriez vous une macro équivalente fonctionnant sous de nombreuses
configurations (Excel et Windows) ?
Bonjour. Comment fais-tu pour remonter "à la racine de la racine" ? Daniel
Bonjour,
Anciennement j'utilisai une macro pour sélectionner un fichier à partir d'une racine...
Function ChoixDossierFichier(Racine, Optional SelType As Byte = 0) Dim objShell, objFolder, Chemin, SecuriteSlash, FlagChoix&, Msg$
If SelType = 0 Then FlagChoix = &H1&: Msg = "Choisissez un dossier :" Else FlagChoix = &H4000&: Msg = "Choisissez un fichier :" End If
Set objShell = CreateObject("Shell.Application") 'le troisième paramètre permet de choisir 'la sélection d'un dossier (0) ou d'un fichier (1) 'le dernier paramètre permet de choisir le dossier racine Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix,Racine) On Error Resume Next Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & "" If objFolder.Title = "" Then Chemin = "" End If
SecuriteSlash = InStr(objFolder.Title, ":")
If SecuriteSlash > 0 Then Chemin = Mid(objFolder.Title, SecuriteSlash - 1, 2) & "" End If ChoixDossierFichier = Chemin End Function
Mon problème est que cette macro plante de manière quasiment systèmatique dès que l'on sélectionne un fichier à la racine de la racine précisée... J'ai alors un message "Erreur d'exécution '-2147024894 (80070002)': La méthode 'BrowseForFolder' de l'objet 'IShellDispatch4' a échoué."
J'ai le problème sur mon poste avec Excel 2007 et Windows XP SP3... Le problème se posait déja avec XP SP2. Je ne sais si cela vient de la version d'Excel ou de la version Windows... Je n'ai pas de références manquantes...
Savez vous d'où peut venir le problème ? Et si l'on ne peut pas le résoudre auriez vous une macro équivalente fonctionnant sous de nombreuses configurations (Excel et Windows) ?
FFO
Salut à toi
Si j'ai bien compris la finalité de ce code il récupère d'abord l'adresse d'un répertoire puis avec cette adresse celle d'un fichier sélectionné dans ce répertoire
Dans cet esprit je te propose ce code à mettre dans le VBA de la feuille :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target = "" Then With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ActiveWorkbook.Path & "" .Title = "Veuillez choisir le Dossier" .Show If .SelectedItems.Count > 0 Then ChoixDossier = .SelectedItems(1) Else ChoixDossier = "" End If End With Target = ChoixDossier Else If Target Like "*:*" Then ChDrive (Left(Target, 1)) ChDir Range(Target.Address) Fichier = Application.GetOpenFilename(, , "Veuillez choisir le ficher") If Fichier <> "Faux" Then Target = Fichier End If End If End If End Sub
Par un double click d'une cellule vide une boîte de dialogue demandera à choisir un dossier Son adresse sera recopié dans cette cellule Puis par un nouveau double click une nouvelle boîte de dialogue dans ce dossier demandera à choisir un fichier Son adresse sera recopiée dans cette cellule
Celà correspond il à ton attente
Dis moi !!!!
Salut à toi
Si j'ai bien compris la finalité de ce code il récupère d'abord l'adresse
d'un répertoire puis avec cette adresse celle d'un fichier sélectionné dans
ce répertoire
Dans cet esprit je te propose ce code à mettre dans le VBA de la feuille :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As
Boolean)
If Target = "" Then
With Application.FileDialog(msoFileDialogFolderPicker)
.InitialFileName = ActiveWorkbook.Path & ""
.Title = "Veuillez choisir le Dossier"
.Show
If .SelectedItems.Count > 0 Then
ChoixDossier = .SelectedItems(1)
Else
ChoixDossier = ""
End If
End With
Target = ChoixDossier
Else
If Target Like "*:*" Then
ChDrive (Left(Target, 1))
ChDir Range(Target.Address)
Fichier = Application.GetOpenFilename(, , "Veuillez choisir le ficher")
If Fichier <> "Faux" Then
Target = Fichier
End If
End If
End If
End Sub
Par un double click d'une cellule vide une boîte de dialogue demandera à
choisir un dossier
Son adresse sera recopié dans cette cellule
Puis par un nouveau double click une nouvelle boîte de dialogue dans ce
dossier demandera à choisir un fichier
Son adresse sera recopiée dans cette cellule
Si j'ai bien compris la finalité de ce code il récupère d'abord l'adresse d'un répertoire puis avec cette adresse celle d'un fichier sélectionné dans ce répertoire
Dans cet esprit je te propose ce code à mettre dans le VBA de la feuille :
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Target = "" Then With Application.FileDialog(msoFileDialogFolderPicker) .InitialFileName = ActiveWorkbook.Path & "" .Title = "Veuillez choisir le Dossier" .Show If .SelectedItems.Count > 0 Then ChoixDossier = .SelectedItems(1) Else ChoixDossier = "" End If End With Target = ChoixDossier Else If Target Like "*:*" Then ChDrive (Left(Target, 1)) ChDir Range(Target.Address) Fichier = Application.GetOpenFilename(, , "Veuillez choisir le ficher") If Fichier <> "Faux" Then Target = Fichier End If End If End If End Sub
Par un double click d'une cellule vide une boîte de dialogue demandera à choisir un dossier Son adresse sera recopié dans cette cellule Puis par un nouveau double click une nouvelle boîte de dialogue dans ce dossier demandera à choisir un fichier Son adresse sera recopiée dans cette cellule
