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

Rechercher des sujets similaires à "enregistrer fichier repertoire inexistant"