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:
j'ai l'erreur Chemin d'accès introuvable qui vient dès le If Dir (Chemin)
Bien à vous
Jujunexcelpas
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
Bien à vous
Jujunexcelpas