Problème d'autorisation d'accès VBA Excel 2016
j
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 FunctionCordialement
jujudésexcel