(Résolu) Rendre compatible ce code sous mac

[Psycolab]

Bonjour à tous,

J'ai trouvé ce code ( cf plus bas) sur le net et il marche très bien sur PC ( Merci à son créateur) mais j'aurais besoin de le rendre compatible sur exel mac 2011 qui ne gère pas les objets utilisant les contrôles active X.
Mon niveau de VBA ne me permet pas de le faire et je ne trouve pas grand chose sur le net.

En vous remerciant par avance pour le coup de main,
Cordialement,
Nicolas

Sub Test ()

' ne pas actualiser l'ecran gain de vitesse
  Application.ScreenUpdating = False
  
   Dim objShell As Object, objFolder As Object, oFolderItem As Object
   Dim chemin As String
    
    Set objShell = CreateObject("Shell.Application")
    Set objFolder = objShell.BrowseForFolder(&H0&, "Choisir un dossier", &H1&)
    
    On Error Resume Next
    Set oFolderItem = objFolder.items.Item
    chemin = oFolderItem.Path

end sub

 

[Psycolab]

Re : Rendre compatible ce code sous mac

Bon personne n'a rien proposé alors je vais posté ce que j'ai trouvé sur un autre fofo et ça marche sur pc (2010), Bon après test sous Mac il y a une erreur d'éxécution 53 et la macro bug !
Des d'idées ? SVP

(J'ai très peu modifié le code original trouvé la . merçi Thierry )

Private Const BIF_RETURNONLYFSDIRS = 1
Private Const BIF_DONTGOBELOWDOMAIN = 2
Private Type BrowseInfo
    hwndOwner As Long
    pIDLRoot As Long
    pszDisplayName As Long
    lpszTitle As Long
    ulFlags As Long
    lpfnCallback As Long
    lParam As Long
    iImage As Long
End Type
 
Private Declare Function SHBrowseForFolder Lib "shell32" (lpbi As BrowseInfo) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32" (ByVal pidList As Long, _
        ByVal lpBuffer As String) As Long
Private Declare Function lstrcat Lib "kernel32" Alias "lstrcatA" (ByVal lpString1 As String, _
        ByVal lpString2 As String) As Long
 
Public Function SelectFolder(Titre As String, Handle As Long) As String
Dim lpIDList As Long
Dim strBuffer As String
Dim strTitre As String
Dim tBrowseInfo As BrowseInfo
 
    strTitre = Titre
    With tBrowseInfo
        .hwndOwner = Handle
       .lpszTitle = lstrcat(strTitre, "")    ' <- Bug la
        .ulFlags = BIF_RETURNONLYFSDIRS + BIF_DONTGOBELOWDOMAIN
    End With
 
   lpIDList = SHBrowseForFolder(tBrowseInfo) ' <- Bug la
 
    If (lpIDList) Then
        strBuffer = String(255, vbNullChar)
        SHGetPathFromIDList lpIDList, strBuffer
        SelectFolder = Left(strBuffer, InStr(strBuffer, vbNullChar) - 1)
    End If
End Function

Sub Choisir_Dossier_Cible()

Dim Chemin As String

  Chemin = SelectFolder("Choisir le répertoire par défaut", 0)
   MsgBox Chemin
End Sub

 

[Psycolab]

Re : Rendre compatible ce code sous mac

Bonjour à tous,

J'ai réussi à trouvé un site très utile grâce à un membre d'un autre forum qui est spécialisé sur les macro pour Mac voici le lien :

VBA code in Excel 2011 for the Mac

J’espère que ça pourra aider d'autre personne.

Cordialement,

Nicolas