problème de fonction Dir (chemin)

jujunexcelpas

XLDnaute Nouveau
Bonsoir le forum,
Après avoir bien bossé sur les macros excel VBA avec votre aide précieuse, je viens d'avoir un nouveau travail et toute l'entreprise tourne sous MAC, je dois donc bidouiller mes codes avec les chemins d'accès. problème après de nombreuses recherches et tentatives je m'y perd. Pourriez vous jeter un coup d'oeil s'il vous plaît car la je bloque
Je vous transmet le code:
HTML:
Dim xnomfic As String, ficd As String, xcell As String, xnomsh As Variant
Dim i As Long
Dim xshcherchee As Worksheet
Dim classeur As Workbook
Dim wb As Workbook
Dim ws As Worksheet, ok As Boolean
Dim Legraph As ChartObject

Sub EnregistrerNom()
  'CREER UN DOSSIER
   s = Feuil4.[A1]
    r = Feuil23.[c2]
   [COLOR="#FFFF00"] If Dir("Disque dur:Utilisateurs:" & s & ":Bureau:Dropbox:Joueurs:" & r & "") = "" Then _[/COLOR]
    MkDir "Disque dur:Utilisateurs:" & s & ":Bureau:Dropbox:Joueurs:" & r
' CREER UN CLASSEUR dans le dossier
    Application.ScreenUpdating = False
    xnomfic = Range("C2"): ficd = xnomfic & " Mus.xlsx": xcell = Range("B3"): xnomsh = Replace(xcell, "/", "")
  ' CREER UN CLASSEUR
    Application.ScreenUpdating = False
    xnomfic = Range("C2"): ficd = xnomfic & " Mus.xlsx": xcell = Range("B3"): xnomsh = Replace(xcell, "/", "")
    
  ' Contrôle de l'existence du fichier ou classeur
    If FichierExiste("Disque dur:Utilisateurs:" & s & ":Bureau:Dropbox:joueurs:" & r & ":" & ficd) = "Vrai" Then ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
        ' ------------------------------------------------------------------------------------------------------------------
        ' Le classeur existe - On recherche si la feuille existe
        Workbooks.Open ("Disque dur:Utilisateurs:" & s & ":Bureau:Dropbox:joueurs:" & r & ":" & ficd), UpdateLinks:=0: Workbooks(ficd).Activate  ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
         ActiveWindow.DisplayGridlines = False
         For Each xshcherchee In Worksheets
                If xshcherchee.Name = xnomsh Then
                
                
                 Workbooks("Mus.xlsm").Sheets("Modele").Range("B3:N34").Copy
                Workbooks("Mus.xlsm").Sheets("Modele").Shapes.Range(Array("Picture 17", "Picture 19", "Picture 9", "Picture 10", "Picture 11", "Picture 12", "Picture 13", "Picture 14", "Picture 15", "Picture 16")).Select
            With ActiveWorkbook.Sheets(xnomsh).Range("B1048576").End(xlUp)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            
             Application.DisplayAlerts = False
             
               Workbooks("Mus.xlsm").Sheets("Modele").Range("o3:O34").Copy
            With ActiveWorkbook.Sheets(xnomsh).Range("O1048576").End(xlUp)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteFormulas
            
            
            
             Workbooks("Mus.xlsm").Sheets("Modele").Range("A35:O37").Copy
            With ActiveWorkbook.Sheets(xnomsh).Rows(Sheets(xnomsh).Range("B" & Rows.Count).End(xlUp).Row + 1).Insert
            
            Workbooks("Mus.xlsm").Sheets("Modele").Range("D2:F2").Copy
            With ActiveWorkbook.Sheets(xnomsh).Range("D2")
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteFormulas
            .Rows("1:1000").RowHeight = 14.3
            
            For Each Legraph In ActiveSheet.ChartObjects
                     Legraph.Delete
                Next
                 ActiveWorkbook.Save: ActiveWorkbook.Close
                 Workbooks("Mus.xlsm").Sheets("Modele").Activate
                 MsgBox "Le dernier programme a bien été edité !"
                    Exit Sub
            End With
            End With
            End With
            End With
                End If
        Next
       
         ' Le classeur existe - On ajoute la feuille
        Worksheets.Add After:=Sheets((Sheets.Count)): Worksheets(Sheets.Count).Name = xnomsh
       
         Workbooks("Mus.xlsm").Sheets("Modele").Range("A1:O4").Copy
         Workbooks("Mus.xlsm").Sheets("Modele").Shapes.Range(Array("Picture 17", "Picture 19", "Picture 9", "Picture 10", "Picture 11", "Picture 12", "Picture 13", "Picture 14", "Picture 15", "Picture 16")).Select
         With ActiveWorkbook.Sheets(xnomsh).Range("A1")
                .Range("A1:O4").PasteSpecial Paste:=xlPasteFormats
                '.Range("A1:O4").PasteSpecial Paste:=xlPasteFormulas
                .Range("A1:O4").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                .Range("A1:O4").PasteSpecial Paste:=xlPasteColumnWidths
                .Rows("4:34").RowHeight = 14.25
                .Application.CutCopyMode = False
          Application.DisplayAlerts = False
          
         Workbooks("Mus.xlsm").Sheets("Modele").Range("A5:N34").Copy
                'Workbooks("Mus.xlsm").Sheets("Modele").Shapes.Range(Array("Picture 17", "Picture 19", "Picture 9", "Picture 10", "Picture 11", "Picture 12", "Picture 13", "Picture 14", "Picture 15", "Picture 16")).Select
            With ActiveWorkbook.Sheets(xnomsh).Range("A1048576").End(xlUp)(2)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteValuesAndNumberFormats
            .Rows("1:1000").RowHeight = 14.3
            
               Workbooks("Mus.xlsm").Sheets("Modele").Range("o5:O34").Copy
               'Workbooks("Mus.xlsm").Sheets("Modele").Shapes.Range(Array("Picture 17", "Picture 19", "Picture 9", "Picture 10", "Picture 11", "Picture 12", "Picture 13", "Picture 14", "Picture 15", "Picture 16")).Select
            With ActiveWorkbook.Sheets(xnomsh).Range("o1048576").End(xlUp)(2)
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteFormulas
            .Rows("1:1000").RowHeight = 14.3
            
            Workbooks("Mus.xlsm").Sheets("Modele").Range("A35:O37").Copy
            With ActiveWorkbook.Sheets(xnomsh).Rows(Sheets(xnomsh).Range("B" & Rows.Count).End(xlUp).Row + 1).Insert
            
            Workbooks("Mus.xlsm").Sheets("Modele").Range("D2:F2").Copy
            With ActiveWorkbook.Sheets(xnomsh).Range("D2")
            .PasteSpecial Paste:=xlPasteFormats
            .PasteSpecial Paste:=xlPasteFormulas
            .Rows("1:1000").RowHeight = 14.3
            
            For Each Legraph In ActiveSheet.ChartObjects
                     Legraph.Delete
                Next
               
                 ActiveWorkbook.Save: ActiveWorkbook.Close
                 Workbooks("Mus.xlsm").Sheets("Modele").Activate
                 MsgBox "Une nouvelle semaine commence !"
                    Exit Sub
            End With
            End With
            End With
            End With
            End With
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFullScreen = True
        Application.CutCopyMode = False
        ActiveWindow.DisplayZeros = False
        ActiveWindow.DisplayGridlines = False
        ActiveWorkbook.Save
        ActiveWorkbook.Close
    MsgBox "Sauvegarde " & r & " effectuée."
        ' ------------------------------------------------------------------------------------------------------------------
    Else
        '___________________________________________________________________________________________________________________
        ' Création du fichier ou classeur et copie de la feuille modele
        Workbooks.Add
        Workbooks("Mus.xlsm").Sheets("Modele").Range("A:AG").Copy
        Workbooks("Mus.xlsm").Sheets("Modele").Shapes.Range(Array("Picture 17", "Picture 19", "Picture 9", "Picture 10", "Picture 11", "Picture 12", "Picture 13", "Picture 14", "Picture 15", "Picture 16")).Select
            With ActiveWorkbook.Sheets("Feuil1")
                .Range("A:AG").PasteSpecial Paste:=xlPasteFormats
                .Range("A:AG").PasteSpecial Paste:=xlPasteValuesAndNumberFormats
                .Range("A:AG").PasteSpecial Paste:=xlPasteColumnWidths
                .Rows("4:34").RowHeight = 14.25
                '.Application.CutCopyMode = False
                
                Workbooks("Mus.xlsm").Sheets("Modele").Range("A36:O37").Copy
                
                 With ActiveWorkbook.Sheets("Feuil1")
                .Range("A36:O37").PasteSpecial Paste:=xlPasteFormulas
                .Application.CutCopyMode = False
                
            Workbooks("Mus.xlsm").Sheets("Modele").Range("O5:O34").Copy
                 With ActiveWorkbook.Sheets("Feuil1")
                .Range("O5:O34").PasteSpecial Paste:=xlPasteFormulas
                .Range("A1").Select
            End With
            End With
            End With
            ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
        Application.DisplayFullScreen = True
        Application.CutCopyMode = False
        ActiveWindow.DisplayZeros = False
        ActiveSheet.Name = xnomsh
        ActiveWorkbook.SaveAs Filename:="Macintosh HD:Users:" & s & ":dropbox:joueurs:" & r & ":" & xnomfic & " Musculation.xlsx"   ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
       
        ActiveWorkbook.Close
       MsgBox "Le Dossier " & r & " a bien été créé."
       
    End If
    'ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, copies:=1, collate:=0
    
        '___________________________________________________________________________________________________________________

    Application.ScreenUpdating = True
End Sub

Function FichierExiste(ficd) As Boolean
    FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
j'ai l'erreur Chemin d'accès introuvable qui vient dès le If Dir (Chemin)
Bien à vous
Jujunexcelpas
 

Discussions similaires

Réponses
3
Affichages
826

Statistiques des forums

Discussions
315 093
Messages
2 116 136
Membres
112 667
dernier inscrit
foyoman