Enregistrer un fichier dans un répertoire inexistant
Bonjour à vous,
J'ai besoin d'un petit coup de main.
Je cherche à enregistrer un fichier Excel dans un dossier qui n'existe pas encore. L'idée est de créer le dossier dans la macro et enregistrer le fichier dans ce nouveau dossier.
Voici ce que j'ai codé pour le moment
Dim chemin As String
chemin = "/Users/tf/Documents/A & S/Clients/"
ActiveWorkbook.SaveAs Filename:=chemin & "[B1]/" & "Page de garde" & ".xlsm"
Dim CellNVide As Long
CelNVide = Range("B1").End(xlDown).Row
Workbooks("APPLICATION AETS.xlsm").Activate
Sheets("Clients").Select
Range("B1").Offset(Derligne).Select
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=chemin & ActiveCell.Value & ".xlsm"
Le nom du dossier doit prendre la valeur contenue dans la cellule B1.
Le nom du fichier reste figé "Page de garde"
De plus je souhaite créer un hyper lien qui tient compte de la viabilité du chemin d'accès.
Avez-vous des suggestions?
Par avance merci de votre aide!
Flo
Bonjour
il faut par exemple utiliser la fonction MKDIR
Exemple : test si le dossier existe pas on fait la création du dossier
chemin = "C:/Users/tf/Documents/A & S/Clients/" & [B1]
If Dir(chemin, vbDirectory) = "" Then MkDir chemin 'création du sous-dossier
mais avant cela il faut peut-etre vérifier que B1 n'est pas vide...
et il faut que le chemin soit complet avec C: avec le user dans ton code
Fred
Bonjour Fred 2406,
Tout d'abord merci pour ce début de réponde.
Malheureusement pour le moment ça ne fonctionne pas.
J'avais déjà testé la fonction mkdir, mais je ne sais pas bien l'utiliser d'où ma question sur le forum.
Quand je rédige la macro comme tu me l'as indiqué j'ai un message d'erreur:
Erreur d'exécution "53"
Fichier introuvable
Et pour répondre aux deux autres question, la cellule B1 n'est pas vide lorsque l'enregistrement est lancé et le chemin est complet et fonctionnel car je l'utilise dans une autre macro et ça fonctionne.
Dans l'attente de ton retour.
Merci par avance
Flo
Bonjour
il faudrait déjà dire sur quelle ligne le code bloque...
a mon avis cela doit être sur ton save as...
ActiveWorkbook.SaveAs Filename:=chemin & "[B1]/" & "Page de garde" & ".xlsm"
je commencerais part :
ActiveWorkbook.SaveAs Filename:=chemin & "\" & [B1] & "\Page de garde" & ".xlsm", FileFormat:= xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
il faut évidement faire la création du sous dossier B1 avant...
le mieux c'est que tu explique ce que tu recherche a faire... un peu plus précisément... et fournisse un fichier test en ayant supprimer les données confidentielles..
Fred
Re oulala... je viens de voir que tu es sous MAC....
cela va compliquer un peu les choses... et en effet la fonction MKDIR ne fonctionne pas sous MAC...
je te renvoi sur un site qui est une référence en la matière :
et pour mac2016 il y a une particularité :
tu y trouveras ton bonheur (je penses...)
Fred
Hahaha! ok merci je vais jeter un oeil
J'espère en effet trouver ma réponse :S
Bonne journée!
j'ai édité mon message précédent.. mais pas sur que tu as vue...
donc pour office 2016 il y a une particularité :
Fred
Re,
J'ai déjà fait les modifications que tu suggères, voilà le code que j'ai:
Dim chemin As String
chemin = "/Users/tetardflorian/Documents/Arômes & Saveurs/Clients/" & [B1]
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
ActiveWorkbook.SaveAs Filename:=chemin & "/" & [B1] & "/Page de garde" & ".xlsm", FileFormat:=xlOpenXMLWorkbookMacroEnabled, CreateBackup:=False
J'ai toujours le même message d'erreur "Erreur d'exécution 53".
L'erreur sur le code est sur:
If Dir(chemin, vbDirectory) = "" Then MkDir chemin
Oui en effet... comme je l'ai dit MKdir ne fonctionne pas sur MAC.... ou du moins ne fonctionnait pas avant...
je te renvoi sur
a priori et il faut utiliser une fonction
Function CreateFolderinMacOffice2016(NameFolder As String) As String
'Function to create folder if it not exists in the Microsoft Office Folder
'Ron de Bruin : 1-Feb-2019
Dim OfficeFolder As String
Dim PathToFolder As String
Dim TestStr As String
OfficeFolder = MacScript("return POSIX path of (path to desktop folder) as string")
OfficeFolder = Replace(OfficeFolder, "/Desktop", "") & _
"Library/Group Containers/UBF8T346G9.Office/"
PathToFolder = OfficeFolder & NameFolder
On Error Resume Next
TestStr = Dir(PathToFolder & "*", vbDirectory)
On Error GoTo 0
If TestStr = vbNullString Then
MkDir PathToFolder
'You can use this msgbox line for testing if you want
'MsgBox "You find the new folder in this location :" & PathToFolder
End If
CreateFolderinMacOffice2016 = PathToFolder
End Function
on l'appel avec par exemple :
Call CreateFolderinMacOffice2016(NameFolder:="MyProject")
mais avant cela... il faut faire :
Problems with Apple’s sandbox requirements and Mac Office 2016 with VBA code
In Windows Excel 97-2016 and in Mac Excel 2011 you can open files or save files where you want in almost every folder on your system without warnings or requests for permission. But in Mac Office 2016 Microsoft have to deal with Apple’s sandbox requirements. When you use VBA in Mac Excel 2016 that Save or Open files you will notice that it is possible that it will ask you permission to access the file or folder (Grant File Access Prompt), this is because of Apple’s sandbox requirements.This means that when you want to save/open files or check if it exists with VBA code the first time you will be prompted to allow access on the first attempt to access such a folder or file.
How to avoid problems
There are a few places on your Mac that you can use to avoid the prompts and let your code do what it needs to do without user interaction. But these folders are not in a place that a user can easily find so below are some steps that I hope to make it easier for you to access the folder manual if you want.
This is the Root folder on my machine that we use in the examples on this page:
/Users/rondebruin/Library/Group Containers/UBF8T346G9.Office
Note: rondebruin is the user name in this path and I agree that the naming of the folder for Office(UBF8T346G9.Office) is not so nice, but Microsoft must use that of Apple.
The folder above you can use to share data between Office programs or with a third party application, so this location will always work if you want to have read and write access. If you want to have a location only for Excel for example use this path : /Users/rondebruin/Library/Containers/com.microsoft.Excel/Data
I not use this location on this example page to be sure that every Office program can access my files if this is needed.
Manual create a folder for your Excel files in the Office folder
Open a Finder Window
Hold the Alt key when you press on Go in the Finder menu bar
Click on Library
Open the Group Containers folder
Open the UBF8T346G9.Office folder
Create a Folder inside this folder named MyExcelFolder for example
Select this folder
This are three ways to easily open the folder manual :
Add it to your Favorites in Finder by dragging it to it.
Add it to your Favorites in Finder with the shortcut : cmd Ctrl T
Drag the folder to the Desktop with the CMD and Alt key down. You now have a link(alias) to the folder on your desktop so it is easy to find it and open it in the future.
Note : Adding the folder to your Favorites is my favorite because you see the folder in your open and save dialogs in Excel.
Fred
Oui c'est bon ça fonctionne!
Merci pour ton aide
Bon maintenant j'ai un problème pour créer mon lien hypertexte derrière mais je vais me débrouiller, malgré une bonne rédaction de ma macro je n'arrive pas à atteindre ma cellule nouvellement crée qui est "la dernière non vide de ma colonne"...
Tant mieux !!!
j'avoue ne pas avoir compris la question dans ton dernier post....
peux-tu dire un peu plus sur ce que tu souhaites faire
Fred
hello,
Désolé pour ma réponse tardive.
Ce que je souhaite faire c'est créer un hyperlien d'une cellule vers le fichier que j'ai créé juste avant.
La cellule en question étant la dernière cellule non-vide d'une colonne.
J'ai travaillé sur deux méthodes, en partant du haut de la colonne et en partant du bas mais c'est un échec dans les deux cas:
Dim DerLigne As Long
DerLigne = Range("B1").End(xlDown).Row
chemin = "/Users/tf/AetS/Clients"
Workbooks("AetS.xlsm").Activate
Sheets("MP").Select
Range("B1").Offset(Derligne).Select
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=chemin & ActiveCell.Value & ".xlsm"
Code en partant du haut de ma colonne, mais le lien est créé dans la première cellule de la colonne
Dim Derligne As Integer
Derligne = Range("B1048576").End(xlUp).Row
chemin = "/Users/tf/AetS/Clients"
Workbooks("AetS.xlsm").Activate
Sheets("MP").Select
Range("B1").Offset(Derligne).Select
ActiveCell.Hyperlinks.Add Anchor:=Selection, Address:=chemin & ActiveCell.Value & ".xlsx"
Code en partant du bas de ma colonne, mais le lien est créé dans la 13ème cellule de la colonne
Voilà mon soucis. Je pense qu'il y a une petite erreur de code quelque part mais je ne la trouve pas sachant que cette méthode fonctionne sur d'autres macros que j'utilise régulièrement...
Dans l'attente de te lire. Par avance merci
BOnjour
si tu connais la dernière ligne occupée avec
DerLigne = Range("B1").End(xlDown).Row
il suffit de faire le lien hypertexte dans celle ligne colonne B ?? si j'ai bien compris
donc je verrais plutôt quelque chose comme cela :
ActiveSheet.Hyperlinks.Add Anchor:=cells(DerLigne,"B"), Address:=chemin & ActiveCell.Value & ".xlsm"
mais pas testé
Fred
Merci pour ton retour.
Sur le principe ça fonctionne, mais ça ne va pas sur la bonne cellule, ça va deux cellules plus bas que ce que je veux et je ne sais pas pourquoi j'ai ce décalage
Donne un fichier test...
il faut comprendre pourquoi DerLigne ne te donne pas ce que tu attends....
Fred
Re
je viens de penser a quelque chose....
essai avec cette instruction pour déterminer la Derligne :
DerLigne = Range("B" & Rows.Count).End(xlUp).Row
Fred
Bonjour Fred,
Excuse pour cette réponse en décalé.
Je viens de faire l'essai avec ce que tu m'as proposé, malheureusement le problème persiste, le lien est bien collé dans la bonne colonne mais plusieurs lignes en dessous de là où je veux...
Flo
Re bonjour
Met a dispo un fichier test sans données confidentielles
je regarderais dans l'après midi
Fred
Merci pour ta disponibilité en tout cas!
Je mets les fichiers en pièce jointe.
L'idée est de faire l'entrée des données sur le fichier "APPLICATION A_ET_S" ces données sont copiées sur le fichier "Modele fiche client" et la ligne correspondant au client est crée sur l'application avec création du lien hypertexte vers la fiche client. Je serai connecté cet après-midi donc je pourrai répondre rapidement.
Merci encore Fred
je suis pas sur d'avoir tout compris...
mais peut-être que le problème vient de là, il a beaucoup de select et copy et paste... qui peuvent être simplifier normalement... mais sous mac... je ne suis plus sur de rien...
remplace
ton debut de code
Sheets("Gestion des formules").Select
Range("A29:J29").Select
Selection.Copy
Sheets("Clients").Select
Range("A1").Offset(Derligne).Select
Selection.PasteSpecial Paste:=xlValues, operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
Application.CutCopyMode = False
par
Sheets("Gestion des formules").Range("A29:J29").Copy
Derligne = Sheets("Clients").Range("A1048576").End(xlUp).Row
If Derligne = 2 And Sheets("Clients").[A2] = "" Then Derligne = 1
Sheets("Clients").Cells(Derligne + 1, "A").PasteSpecial Paste:=xlValues, operation:=xlNone, SkipBlanks:= _
False, Transpose:=False
en ayant pris le soin de mettre la déclaration dim Derligne avant ce bloc
le problème se pose pour la première fois aussi avec cette configuration car ton tableau doit absolument avoir une ligne vide au départ... d'ou une petite astuce avec
If Derligne = 2 And Sheets("Clients").[A2] = "" Then Derligne = 1
Fred