1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
| Sub NewOpenGetFiles()
On Error Resume Next
Paths = NewOpenGetMyFiles("XLS,PDF,XLSM,TXT", , True) '"XLS,PDF,XLSM,TXT" => On définit les types ici pas les extensions - si paramètre non remplit, tous les types son pris en compte
If Err.Number > 0 Then MsgBox "Sélection du/des Fichier(s) annulée": Exit Sub
If TypeName(Paths) = "String" Then
Debug.Print TypeName(Paths) & " : " & Paths ' résultat lorsqu'il y a seulement 1 sélection
Else
For Each Chm In Paths
Debug.Print Chm 'Résultat lors d'une multi-sélection
'Workbooks.Open chm
Next
End If
On Error GoTo 0
End Sub
'========================================================================================================================
'========================================================================================================================
'Auteur: RyuAutodidacte - Version 2.02 (Forum developpez.net VBA/AppleScript)
'Créé le 26/02/2017 à la sueur de mes neurones :) - modification le 01/03/2017
'
'Fonction permettant de remplacer GetOpenFileName sur Mac et là, les accents sont pris en compte (bien que déconseillé de nommer des repertoires/fichier avec accents)
'
'NewOpenGetMyFiles(Extension, Dossier de départ, multi-sélection en On/Off)
'
'--- Nommage des extensions ==>string entre 2 guillemets - séparation des types en capital par une virgule sans espaces (afin de définir les extensions) :
'---------- Exemple : "PDF,XLS" ou bien "XSLM,TXT,PDF,PSD" => attention on définit les types ici pas les extensions
'--- Choix du dossier de départ -> string ==> si vide "le bureau" est choisi d'office - sinon mettre un repertoire, ex : ""Macintosh HD:Users:NomUser:Desktop:DeveloppezCom:GetOpenMyFiles:"
'--- Multi-selection de fichiers ==> Boolean : par défaut la sélection est unique, mettre True pour une sélection multiple
'------> Merci à PBELL, l'un des seul rescapé du forum AppleScript ;), heureusement qu'il est toujours présent :D, pour son aide afin que j'y vois plus clair et de sa contribution
'------> Merci à joe.levrai de m'avoir donné la bonne direction à prendre
'========================================================================================================================
Function NewOpenGetMyFiles(Optional MyExt As String, Optional D_Location As String, Optional MultiSelection As Boolean = False) As Variant
Dim ScExt$, D_Loc$, MultiFiles$, MyPaths As String, PP As New MSForms.DataObject, Paths
'----- PARAMETRES : EXTENSIONS--------------------------------------------------------------------------------
If MyExt = "" Then ScExt = "" Else For Each Ext In Split(MyExt, ","): ScExt = ScExt & """" & UCase(Ext) & """" & " ": Next: ScExt = " of type {" & Replace(Trim(ScExt), " ", ", ") & "}"
'----- PARMETRES : CHOIX DU DOSSIER PAR DEFAUT------------------------------------------------------------------
If D_Location = "" Then D_Loc = " default location (path to desktop folder) " Else D_Loc = " default location alias " & Chr(34) & D_Location & Chr(34)
'-----PARMETRES : SELECTION UNIQUE OU MULTIPLE DES FICHIERS-------------------------------------------------------
If MultiSelection Then MultiFiles = " with multiple selections allowed"
'---- SCRIPT : MACSCRIPT / APPLESCRIPT EN VBA---------------------------------------------------------------------
MyPaths = MacScript("set AppleScript's text item delimiters to return" & Chr(13) & _
"set source to (choose file with prompt ""Sélectionner un ou plusieurs fichiers :""" & ScExt & D_Loc & MultiFiles & ") as text" & Chr(13) & _
"set the clipboard to (count (source)) & source as Unicode text")
'----- RECUPERATION DES CHEMINS SELECTIONNE DANS LE PRESSE PAPIER ------------------------------------------------
PP.GetFromClipboard: MyPaths = PP.GetText(): MyPaths = Mid(MyPaths, InStr(MyPaths, vbNewLine) + 1, Split(MyPaths, vbNewLine)(0))
Paths = Split(MyPaths, vbNewLine)
If UBound(Paths) = 0 Then Chm$ = Paths(0): NewOpenGetMyFiles = Chm Else NewOpenGetMyFiles = Paths
End Function |
Encodage en ISO latin 1
en n'oubliant pas d'indiquer qu'elle est la solution finale choisie 
Répondre avec citation
Envoyé par RyuAutodidacte
à toi 
, entre AppleScritp et VBA et une fois finalisé, et que toutes les vérifications étaient OK;
) 
Partager