Bonjour Aliboron,
Merci de te soucier de mon problème
je t'envoi le code entier avec les fonctions que je suis allé chercher chez Ron de Bruin.
il fonctionne bien sur Excel mac 2011:
Sub EditerMuscu()
Application.ScreenUpdating = False
Joueur = Application.PathSeparator & Range("A6")
xnomfic = Range("A6"): ficd = Application.PathSeparator & xnomfic & " Musculation.xlsx": xcell = Range("D2"): xnomsh = Replace(xcell, "_", " ")
If FileOrFolderExistsOnMac(ThisWorkbook.Path & Joueur & ficd) = True Then
Workbooks.Open (ThisWorkbook.Path & Joueur & ficd), UpdateLinks:=0
' 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 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 savechanges:=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 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
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
Sur 2016 il suit bien la procédure du code mais à chaque fois à la fin il ferme tout de façon inattendue et il en va de même pour le code de sortie que j'ai mis en place:
Sub LaSortie()
Sheets("Consulter").Activate
CancelSortie = False
If Sheets("Consulter").Range("A1") = "Julien" Then
ThisWorkbook.Close True
Else
ThisWorkbook.Close False
End If
End Sub
sur 2011 il ferme normalement mais sur 2016 il plante tout le temps
je ne comprend vraiment pas le problème
Cordialement
Julien