Code VBA mettre une fonction dans un privatesub?

Mycki -  
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   -
Bonjour, j'ai effectuer un fichier xls.
Créer des Userform, attribuer du code VBA a des buttons et autres.
Je cherche a attribuer ce code ci dessous. qui est une function a mon button.
Est-t-il possible? donc d'intégrer le code fonction a l'intérieur du Private Sub?

Merci d'avance pour vos réponses qui je l'espère éclaireront ma lanterne.


Car mon bouton commence par: 

Private Sub CommandButton1_Click()

End Sub


et mon code function est: 

Function ChoixDossierFichier(SelType As Byte) As String
     Dim objShell As Object, objFolder As Object
     Dim Chemin As String, Msg As String
     Dim FlagChoix As Long, NbPoint As Integer

     If SelType = 0 Then
          FlagChoix = &H1
          Msg = "Sélectionner un dossier :"
     Else
          FlagChoix = &H4000
          Msg = "Sélectionner un fichier :"
     End If

     Set objShell = CreateObject("Shell.Application")
     ' &h1
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent     ' &h1
' 2ème paramètre Titre de la boite, en dessous de la barre de titre     ' &h1
' 3ème paramètre options de BrowseForFolder     ' &h1
' 4ème paramètre Facultatif. Répertoire de début d'exploration     On Error Resume Next
     Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
     ' &h1
'Si l 'objet retourné est valide, on teste son contenu (item.title)
     'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
     ' suivi de sa lettre et ":" entre parenthèses     NbPoint = InStr(objFolder.Title, ":")
     If NbPoint = 0 Then
          ' &h1
'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
          'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName          Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).path & ""
     Else
          ' &h1
' si racine on récupère la lettre du lecteur et les 2 points          Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
     End If
     ChoixDossierFichier = Chemin
End Function


Merci.
A voir également:

2 réponses

Réponse 1 / 2
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713
 
Bonjour,

appel de fonction: 
Private Sub CommandButton1_Click()
    Dim Typ As Byte
    
    Typ = 1     'ou 0 suivant
    dossier = ChoixDossierFichier(Typ)
End Sub


ou fonction integree: 

Private Sub CommandButton1_Click()
     Dim objShell As Object, objFolder As Object
     Dim Chemin As String, Msg As String
     Dim FlagChoix As Long, NbPoint As Integer
     
    SelType = 1     'ou 0 suivant
     If SelType = 0 Then
          FlagChoix = &H1
          Msg = "Sélectionner un dossier :"
     Else
          FlagChoix = &H4000
          Msg = "Sélectionner un fichier :"
     End If

     Set objShell = CreateObject("Shell.Application")
     ' &h1
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent     ' &h1
' 2ème paramètre Titre de la boite, en dessous de la barre de titre     ' &h1
' 3ème paramètre options de BrowseForFolder     ' &h1
' 4ème paramètre Facultatif. Répertoire de début d'exploration     On Error Resume Next
     Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
     ' &h1
'Si l 'objet retourné est valide, on teste son contenu (item.title)
     'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
     ' suivi de sa lettre et ":" entre parenthèses     NbPoint = InStr(objFolder.Title, ":")
     If NbPoint = 0 Then
          ' &h1
'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
          'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
          Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
     Else
          ' &h1
' si racine on récupère la lettre du lecteur et les 2 points
        Chemin = Mid(objFolder.Title, NbPoint - 1, 2)
     End If
End Sub
1
Mycki
 
Merci pour ta réponse c'est super cela marche parfaitement en code intégré. Je profite de ta réponse pour relancer la chose.

Mon code fonctionne mais j'ai une erreur 91 qui apparaît ici:

Ligne soulignée en gras ;)
Je te remercie d'avance pour la réponse a venir :)

Private Sub CommandButton1_Click()
Dim objShell As Object, objFolder As Object
Dim Chemin As String, Msg As String
Dim FlagChoix As Long, NbPoint As Integer

SelType = 0 'ou 0 suivant
If SelType = 0 Then
FlagChoix = &H1
Msg = "Sélectionner un dossier :"
Else
FlagChoix = &H4000
Msg = "Sélectionner un fichier :"
End If

Set objShell = CreateObject("Shell.Application")
' &h1
' 1er paramètre toujours 0 (zéro). Il représente le handle de la fenêtre parent ' &h1
' 2ème paramètre Titre de la boite, en dessous de la barre de titre ' &h1
' 3ème paramètre options de BrowseForFolder ' &h1
' 4ème paramètre Facultatif. Répertoire de début d'exploration On Error Resume Next
Set objFolder = objShell.BrowseForFolder(&H0&, Msg, FlagChoix)
' &h1
'Si l 'objet retourné est valide, on teste son contenu (item.title)
'Si on a sélectionné la racine d'une partition, il se compose du nom de la partition,
' suivi de sa lettre et ":" entre parenthèses NbPoint = InStr(objFolder.Title, ":")
If NbPoint = 0 Then
' &h1
'Sinon, il se compose du nom du dossier uniquement, sans le chemin précédent
'On récupère ce chemin à l'aide des propriété et méthode ParentFolder.ParseName
Chemin = objFolder.ParentFolder.ParseName(objFolder.Title).Path & ""
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > Mycki
 
Bonjour,
j'ai pris votre code et je n'ai pas d'erreur !!!!!!!
0
Mycki
 
Bizarre cela me généré une erreur des que je sélectionne un dossier dans la fenêtre et click sur ok.... :/
0
Mycki
 
Ahh désolé j'avais lancer la mauvaise userform! Tout es ok.
Par contre j'ai un textbox1, sur ce même userform.
Est-il possible de coller le chemin du dossier précédemment sélectionnez avec le code du dessus dans cet texbox1?

Désolé pour toute mes questions ... mais je suis pas un expert en vba :/
0
f894009 Messages postés 17277 Date d'inscription   Statut Membre Dernière intervention   1 713 > Mycki
 
Re,

en remplacant Chemin par TextBox1
0
Réponse 2 / 2
Yoda
 
Bonjour,

Par exemple 

Private Sub CommandButton1_Click()

'Selectionner dossier
Msgbox "Dossier sélectionné : " & ChoixDossierFichier(0)

'Selectionner fichier
Msgbox "Fichier sélectionné : " & ChoixDossierFichier(1)

End Sub
1

Discussions similaires

Méthode find dans VBA - Recherche de données sous Excel
baissaoui -
baissaoui -

0 réponse