bouton "créer un nouveau dossier" dans une boite de dialogue BrowseForFolder

  • Initiateur de la discussion Initiateur de la discussion romfret
  • Date de début Date de début

Boostez vos compétences Excel avec notre communauté !

Rejoignez Excel Downloads, le rendez-vous des passionnés où l'entraide fait la force. Apprenez, échangez, progressez – et tout ça gratuitement ! 👉 Inscrivez-vous maintenant !

R

romfret

Guest
re le forum ,

j'ai trouvé çà sur le net :


=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!


Sub essai1212()
choix = ChoixDossierFichier("c:\", 1) '<- ici le chemin de tonchoix
If choix <> "" Then MsgBox choix
End Sub

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 ou d'un fichier (0 ou 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 = "Bureau" Then
Chemin = "C:\Windows\Bureau"
End If
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


=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!=:!



Sous office xp j'ai bien un bouton "créer un nouveau dossier" mais sous 2000 je ne l'ai pas, il n'y aurais pas une solution ? Je tiens vraiment à adapter cette boite dialogue pour excel 2000!!
Merci par avance de votre aide,


Romfret
@+, romfret
 
- Navigue sans publicité
- Accède à Cléa, notre assistante IA experte Excel... et pas que...
- Profite de fonctionnalités exclusives
Ton soutien permet à Excel Downloads de rester 100% gratuit et de continuer à rassembler les passionnés d'Excel.
Je deviens Supporter XLD

Discussions similaires

Retour