Problème d'autorisation d'accès VBA Excel 2016

Bonjour à tous,

après un long travail de codage sur EXCEL MAC 2011 alors que je travaillais sur PC, j'ai fais passer mon fichier sur EXCEL MAC 2016 et voilà que je me retrouve avec une demande d'autorisation d'accès qui entraîne une erreur, le code crée le dossier mais plante au moment de l'enregistrement de celui-ci. j'ai regardé sur l'aide microsoft ils parlent d'u problème de sandbox, je n'ai pas tout saisi! quelqu'un aurait il connaissance de ce problème. Car je n'arrive plus à trouver excel 2011 et tout mes collègues tourne sur 2016, que du bonheur. je vous place le code ci dessous:

Sub EditerMuscu()
                Application.ScreenUpdating = False
                Joueur = Application.PathSeparator & Range("A6")
                xnomfic = Range("A6"): ficd = ":" & xnomfic & " Musculation.xlsx": xcell = Range("D2"): xnomsh = Replace(xcell, "_", " ")
                r = Feuil23.[A6]

                 If FileOrFolderExistsOnMac(ThisWorkbook.Path & Joueur & ficd) = True Then

        Workbooks.Open (ThisWorkbook.Path & Joueur & ficd), UpdateLinks:=0 ': Workbooks(ficd).Activate   ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
         Workbooks("Musculation.xlsm").Sheets("Modele").Copy After:=ActiveWorkbook.Sheets(1)
         For Each s In ActiveSheet.Shapes
        If s.Name <> "Picture 15" And s.Name <> "Picture 13" And s.Name <> "Picture 2" And s.Name <> "Chart 11" Then s.Delete
         Next s
         Workbooks("Musculation.xlsm").Sheets("Modele").Range("C4:S9").Copy
         With ActiveSheet
         .Range("C4").PasteSpecial Paste:=xlPasteValues
          .Range("C4").PasteSpecial Paste:=xlPasteFormats
          End With
          ActiveSheet.Name = xnomsh & Sheets.Count - 1
          ActiveWorkbook.Close True
          MsgBox "le Cycle de " & r & " en " & xnomsh & " a bien été édité !"

          Else
          MakeFolderIfNotExist (ThisWorkbook.Path & Joueur)
    Workbooks.Add
Workbooks("Musculation.xlsm").Sheets("Modele").Copy After:=ActiveWorkbook.Sheets(1)
       For Each s In ActiveSheet.Shapes
        If s.Name <> "Picture 15" And s.Name <> "Picture 13" And s.Name <> "Picture 2" And s.Name <> "Chart 11" Then s.Delete

          Next s
        ActiveWindow.DisplayGridlines = False
        ActiveWindow.DisplayHeadings = False
        Application.CutCopyMode = False
        ActiveWindow.DisplayZeros = False
        ActiveSheet.Name = xnomsh & Sheets.Count - 1

        ActiveWorkbook.SaveAs Filename:=ThisWorkbook.Path & Joueur & ficd: ActiveWorkbook.Close True  ' MODIFIER LE CHEMIN DU REPERTOIRE - SI NECESSAIRE
       Application.DisplayAlerts = False
       Workbooks("Musculation.xlsm").Activate
       MsgBox "Le Dossier  de " & r & " a bien été créé et commence par " & xnomsh & " !"
    End If

       Application.ScreenUpdating = True
     ActiveWindow.SelectedSheets.PrintOut from:=1, To:=1, copies:=1, collate:=0

End Sub
Function FichierExiste(ficd) As Boolean
    FichierExiste = Dir(ficd) <> "" And ficd <> ""
End Function
Function FileOrFolderExistsOnMac(FileOrFolderstr As String) As Boolean
'Ron de Bruin : 26-June-2015
'Function to test whether a file or folder exist on a Mac in office 2011 and up
'Uses AppleScript to avoid the problem with long names in Office 2011,
'limit is max 32 characters including the extension in 2011.
    Dim ScriptToCheckFileFolder As String
    Dim TestStr As String

    If Val(Application.Version) < 15 Then
        ScriptToCheckFileFolder = "tell application " & Chr(34) & "System Events" & Chr(34) & _
         "to return exists disk item (" & Chr(34) & FileOrFolderstr & Chr(34) & " as string)"
        FileOrFolderExistsOnMac = MacScript(ScriptToCheckFileFolder)
    Else
        On Error Resume Next
        MyName = Dir(ThisWorkbook.Path & Joueur & ficd, vbDirectory)
        On Error GoTo 0
        If Not MyName = vbNullString Then FileOrFolderExistsOnMac = True
    End If
End Function
Function MakeFolderIfNotExist(Folderstring As String)
'Ron de Bruin, 22-June-2015
' http://www.rondebruin.nl/mac/mac010.htm
    Dim ScriptToMakeFolder As String
    Dim str As String
    If Val(Application.Version) < 15 Then
        ScriptToMakeFolder = "tell application " & Chr(34) & _
                             "Finder" & Chr(34) & Chr(13)
        ScriptToMakeFolder = ScriptToMakeFolder & _
                "do shell script ""mkdir -p "" & quoted form of posix path of (" & _
                        Chr(34) & Folderstring & Chr(34) & ")" & Chr(13)
        ScriptToMakeFolder = ScriptToMakeFolder & "end tell"
        On Error Resume Next
        MacScript (ScriptToMakeFolder)
        On Error GoTo 0

    Else
        str = MacScript("return POSIX path of (" & _
                        Chr(34) & Folderstring & Chr(34) & ")")
        MkDir str
    End If
End Function

Cordialement

jujudésexcel

Rechercher des sujets similaires à "probleme autorisation acces vba 2016"