Discussion :

[Sergio33600]

Bonjour le forum,

J'ai un classeur Excel composé de plusieurs onglets : "Partenaires postulants", "Sorties 2018", "Partenaires", "Sortie", ...
En parcourant divers sujets dans le forum, j'ai trouvé un code qui me permet de faire la copie des onglets "Partenaires postulants", "Sorties 2018" et "Partenaires" dans un nouveau classeur. Le nom du nouveau fichier est le nom saisi dans la cellule M6 de l'onglet "Sortie".
Cette macro me permet aussi de masquer des colonnes et de mettre en couleur des cellules de l'onglet "Sortie", en fonction de la valeur saisie dans la cellule M4 de l'onglet "Sortie" (cela se fait avec les macros Sortie_xxx).
Sur mon PC, tout fonctionne correctement, mais sur d'autres ordi, MAC notamment cela ne marche pas.
La macro va sur l'instruction On Error GoTo Erreur1, la copie des onglets ne se fait pas, un classeur s'ouvre qui ne porte pas le nom saisi dans la cellule M6 de l'onglet "Sortie", avec des onglets vierges, comme si c'était un nouveau classeur.
Voici le code pour copier les onglets :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

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
 
Sub Extraire_Sortie()
    Dim a, e, Rep As Integer, Repertoire As String, Nomsortie As String
    If Range("M4") = 0 Or Range("M4") = "" Then
        Rep = MsgBox("Le n° de la sortie dans la cellule M4 n'a pas été saisi.")
    Else
    If Range("M6") = 0 Or Range("M6") = "" Then
        Rep = MsgBox("Le nom du fichier pour la sauvegarde du fichier Excel joint au compte-rendu de la sortie n'a pas été saisi dans la cellule M6.")
    Else
    If Range("M4") = 905 Then Call Sortie_905
    If Range("M4") = 906 Then Call Sortie_906
    If Range("M4") = 907 Then Call Sortie_907
    If Range("M4") = 908 Then Call Sortie_908
    If Range("M4") = 909 Then Call Sortie_909
    If Range("M4") = 910 Then Call Sortie_910
    If Range("M4") = 911 Then Call Sortie_911
....
....
    MsgBox ("Indiquer le repertoire où sera enregistré le fichier.")
    Repertoire = ChoixDossier
    Application.DisplayAlerts = False
 
    Nomsortie = Sheets("Sortie").Range("M6")
    Rep = vbYes
    If Dir(Repertoire & "\" & Nomsortie & ".xlsx") <> "" Then
        Rep = MsgBox("Ce fichier existe déjà, veux-tu le remplacer ?", vbYesNo)
    End If
 
    If Rep = vbYes Then
        On Error GoTo Erreur1
 
        a = Array("Partenaires des Postulants", "Sorties 2018", "Partenaires")
            With Workbooks.Add(xlWBATWorksheet)
                For Each e In a
                    ThisWorkbook.Sheets(e).Copy After:=.Sheets(.Sheets.Count)
                Next
                .Sheets(1).Delete
                .Sheets(1).Select
                .SaveAs Repertoire & "\" & Nomsortie
                .Close
            End With
    End If
    End If
    End If
 
    Application.ScreenUpdating = True
 
Exit Sub
 
Erreur1:
    MsgBox ("Un fichier portant le même nom est déjà ouvert. Le nom du nouveau fichier sera par défaut Feuil(n) et ne sera pas enregistré.")
 
End Sub

Et le code pour le choix du dossier :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
 
Function ChoixDossier()
 
    Dim Sh, Dos
 
    If Val(Application.Version) >= 10 Then
 
        With Application.FileDialog(msoFileDialogFolderPicker)
            .InitialFileName = ActiveWorkbook.Path & "\"
            ChoixDossier = IIf(.Show = -1, .SelectedItems(1), "")
        End With
 
    Else
 
        Set Sh = CreateObject("Shell.Application")
        Set Dos = Sh.BrowseForFolder(&H0&, "Répertoire.", &H4000)
        ChoixDossier = Dos.ParentFolder.ParseName(Dos.Title).Path & "\"
 
    End If
 
End Function

Ce que j'aurai voulu c'est un code qui permette que cela fonctionne aussi sur Mac.
Merci d'avance pour votre aide.

[SureKey]

Bonsoir,

Votre code créé un "filepath" avec le caractère \, en essayant avec / ?