Code VBA mettre une fonction dans un privatesub?

Mycki -  
f894009 Messages postés 17417 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.

2 réponses

  1.
    f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717
     
    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
    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
    2. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Mycki
       
      Bonjour,
      j'ai pris votre code et je n'ai pas d'erreur !!!!!!!
      0
    3. 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
    4. 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
    5. f894009 Messages postés 17417 Date d'inscription   Statut Membre Dernière intervention   1 717 > Mycki
       
      Re,

      en remplacant Chemin par TextBox1
      0
  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