Ouverture fichier Excel puis Saveas ?

Bonjour,

J'ai le fichier modèle que j'ai mis dans un dossier TOTO, donc utilisateur ouvre ce fichier, une macro s’exécute à l'ouverture de ce fichier vérifie si une cellule est vide si oui alors en enregistre sous le fichier afin de ne pas modifier le fichier modèle dans le répertoire courant TOTO et en créer un sous dossier suivant la variable Entreprise . Ensuite en enregistre le fichier sous ce dossier TOTO\Entreprise\

Si la cellule n'est pas vide alors on ne fait pas enregistre sous.

Le code pour vérifier si la cellule est vide ou pas marche donc la macro s’exécute si la cellule est vide mais j'ai des erreurs

J'ai une erreur qui e dit que mon fichier existe (ce qui est normale car je vient de l'ouvrir) mais cela ne vérifie pas si le sous dossier existe Entreprise

Je n'arrive pas à créer le sous dossier afin que je puisse enregistre sous ce fichier dans le sous dossier

Je vous joint le fichier exemple afin de voir les erreurs puis la macro SaveAs se trouve dans le module SaveAs

Merci pour votre aide

Pour l'info le code pour SaveAs est :

Public Sub SaveAs()

    Dim ChDir As String
    Dim nomfichier As String
    Dim NomCompletFichier As String
    Dim Entreprise As String
    Dim Association As String
    Dim Conducteur As String
    Dim fso
    Dim folder As String

ChDir = Application.ActiveWorkbook.Path 'Chemin courant

Entreprise = Range("Entreprise").Value
Association = Range("ASSO").Value
Conducteur = Range("Conducteur").Value

folder = "ChDir\" & Entreprise 'Entreprise ma variable
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
Shell "Explorer.exe ChDir\" & Entreprise
'MsgBox "dossier d'enregistrement existe"
Else
MkDir "ChDir\" & Entreprise
    End If
nomfichier = Association & "_" & Conducteur & "_"

    'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
    Dim stHeureExport As String
    stHeureExport = "_" & _
        Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
        Format(Second(Time), "00")
    NomCompletFichier = folder & "\" & nomfichier & stHeureExport 'comment creer dossier valeur Entreprise si ActiveWorkbook.Path=C:\documents\

    'Copie de la feuille courante dans un nouveau classeur et enregistrement
  '  ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=NomCompletFichier
  '  ActiveWorkbook.Close

    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier

End Sub

nunizgb a écrit :

Je n'arrive pas à créer le sous dossier afin que je puisse enregistre sous ce fichier dans le sous dossier

Voici une solution que j'ai mise en oeuvre :

    ' choix du modèle de planning vierge
    Set xls = CreateObject("Excel.Application")
    xls.Visible = True
    nomFichierExcel = xls.GetOpenFilename("Fichiers xlsx, *.xlsx", , "Choix du fichier planning modèle")
    If nomFichierExcel = False Then Exit Sub ' sortie si pas de sélection
    xls.Workbooks.Open nomFichierExcel
    Set wb = xls.Workbooks(xls.ActiveWorkbook.Name)

' .....................

    ' sauvegarde planning
    ' -------------------
    CreerRepertoire wb.Path & "\Plannings"
    fichier = wb.Path & "\Plannings\Planning du " & Format(Now(), "yyyy-mm-dd hh\hnn") & ".xlsx"
    wb.SaveAs fichier
    xls.Quit

Fonction création répertoire si inexistant :

Sub CreerRepertoire(strPath As String)
Dim elm As Variant
Dim strCheckPath As String
    strCheckPath = ""
    For Each elm In Split(strPath, "\")
        strCheckPath = strCheckPath & elm & "\"
        If Len(Dir(strCheckPath, vbDirectory)) = 0 Then MkDir strCheckPath
    Next
End Sub

Rebonjour,

J'ai modifier mon code et il marche par contre est-ce qu'on peux l'optimiser, merci

Public Sub SaveAs()

    Dim ChDir As String
    Dim nomfichier As String
    Dim NomCompletFichier As String
    Dim Entreprise As String
    Dim Association As String
    Dim Conducteur As String
    Dim fso
    Dim folder As String

  Entreprise = Range("Entreprise").Value
Association = Range("ASSO").Value
Conducteur = Range("Conducteur").Value

   ChDir = Application.ActiveWorkbook.Path & Application.PathSeparator & Entreprise 'Chemin courant

    If Dir(ChDir, vbDirectory) = "" Then
        MkDir ChDir
    Else
        MsgBox "Le sous dossier existe déjà."
    End If

'folder = "ChDir\" & Entreprise 'Entreprise ma variable
'Set fso = CreateObject("Scripting.FileSystemObject")

nomfichier = Association & "_" & Conducteur & "_"

    'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
    Dim stHeureExport As String
    stHeureExport = "_" & _
        Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
        Format(Second(Time), "00")
    NomCompletFichier = folder & Application.PathSeparator & nomfichier & stHeureExport 'comment creer dossier valeur Entreprise si ActiveWorkbook.Path=C:\documents\

    'Copie de la feuille courante dans un nouveau classeur et enregistrement
  '  ActiveSheet.Copy
    ActiveWorkbook.SaveAs Filename:=NomCompletFichier
  '  ActiveWorkbook.Close

    MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier

End Sub

Edit : Merci Steelson nos message ce sont croiser mais je vais regarde ton code

Bonjour,

tu as un problème avec chDir .... ,

• chDir est une fonction VBA permettant de définir le répertoire courant
• Toi tu définit une variable chaîne ChDir : évite d'utiliser des noms de fonctions comme nom de variable .
• lors que tu écris : "\Chdir" il s'agit du texte \Chdir et pas du contenu de ta variable .., pour utiliser le contenu (la valeur) d'une variable dans une chaîne il faut sortir cette variable des guillemets par exemple avec une variable stChDir (j'ai rajouté le st pour la différentier de la procédure VBA) : tu écris "\" & stChdir .

dans ton cas pour ton répertoire tu peu utiliser ThisworkBook.Path qui contient le répertoire ou est situé ta macro "..

(...)
folder = ThisworkBook.Path  & "\" & Entreprise 'Entreprise ma variable

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
Shell "Explorer.exe " & folder
 'MsgBox "dossier d'enregistrement existe"
Else
MkDir folder
 End If
(..)

Merci Pierre.jy

 ChDir = Application.ActiveWorkbook.Path & Application.PathSeparator & Entreprise 'Chemin courant

        If Dir(ChDir, vbDirectory) = "" Then
            MkDir ChDir
        Else
            MsgBox "Le sous dossier existe déjà."
        End If

J'ai mis ce code est cela me créer mon sous répertoire Documents\Entreprise et sauvegarde le fichier ici et si le sous dossier existe il me le dit et enregistre le fichier aussi

ce code :

(...)
folder = ThisworkBook.Path  & "\" & Entreprise 'Entreprise ma variable

Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
Shell "Explorer.exe " & folder
 'MsgBox "dossier d'enregistrement existe"
Else
MkDir folder
 End If
(..)

il enregistre bien le fichier mais sous le disque dur D:\fichier parce que le dossier documents se trouve sur disque D

Si exécuter la macro tout seule elle marche par contre quand je la met dans ;

If Range("ASSO") <> "" Then
Call SaveAs
 End If

End Sub

J'ai une erreur sachant que ma cellule ASSO est vide

Or ce que je veux quand j'ouvre le fichier nunizgb_saveas, je verifie que la cellule ASSO est vide et si oui alors je sauvegarde sous sans qu'il me demande cela

Mais je vais regarde ton code ainsi celui de Steelson pour faire le code comme il faut

si c'est seulement le message qui te gêne rajoute avant le saveas :

Application.displayAlerts = false 

Merci le message ne s'affiche pas mais mon fichier n'est pas sauvegarde sous le dossier entreprise du coup ma macro ne marche pas :

donc dans thisworkbook j'ai mis cela

Option Explicit
Private Sub Workbook_Open()

Dim ASSO

Set ASSO = Range("ASSO")

If IsEmpty(ASSO.Value) Then
Application.DisplayAlerts = False
Call SaveAs
 End If
End Sub

Donc si la cellule ASSO est vide alors le code de SaveAs doit s’exécuter mais il ne s’exécuter pas

Code SaveAs :

Sub SaveAs()

        Dim stChDir As String
        Dim nomfichier As String
        Dim NomCompletFichier As String
        Dim Entreprise As String
        Dim ASSO As String
        Dim Conducteur As String
        Dim fso
    Dim folder As String

      Entreprise = Range("Entreprise").Value
    ASSO = Range("ASSO").Value
    Conducteur = Range("Conducteur").Value

       stChDir = Application.ActiveWorkbook.Path & Application.PathSeparator & Entreprise 'Chemin courant

        If Dir(stChDir, vbDirectory) = "" Then
            MkDir stChDir
        End If

folder = ThisWorkbook.Path & "\" & Entreprise  'Entreprise valeur de la cellule entreprise

    nomfichier = ASSO & "_" & Conducteur & "_"

        'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
       Dim stHeureExport As String
        stHeureExport = "_" & _
            Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
            Format(Second(Time), "00")
        NomCompletFichier = stChDir & Application.PathSeparator & nomfichier & stHeureExport 

             If Dir(stChDir, vbDirectory) = " & folder" Then

       ActiveWorkbook.SaveAs Filename:=NomCompletFichier
            End If
        MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier

    End Sub

Où est erreur ???

Je vais essayer avec le code de Steelson pour voir si cela marche

cette ligne :

If Dir(stChDir, vbDirectory) = " & folder" Then

est censée faire quoi ?

pierre.jy a écrit :

cette ligne :

If Dir(stChDir, vbDirectory) = " & folder" Then

est censée faire quoi ?

J'ai mis cela afin que Excel ne dit pas que le fichier que j'ai ouvert existe et si je souhaite le modifier, mais je ne sais pas si je l'ai bien écrit.

Parce que lors d'ouverture du fichier via workbook open Excel me dit que le fichier que j'ai ouvert existe ce qui est normal vu que je l'ai ouvert le fichier. Or ce que je cherche c'est de faire sauvegarde sous à conditions que la cellule ASSO est vide.

Si j'executer mon code SAveAs via un bouton, celui m'enregistre bien le fichier en bon endroit : documents\entreprise\Conducteur_date.xls

par contre si j’exécute cette macro via woorkbookopen le fichier n'est pas sauvegarde sous

Je joint un fichier afin de se rendre que le fichier n'est pas sauvegarde le message que le fichier existe ne s'affiche pas car j'ai mis ce code :

On Error Resume Next
SaveAs
On Error GoTo 0

Le code s’exécute par contre au lieu de sauvegarde le fichier dans Documents\Entreprise il me sauvegarde le fichier sous Documents et il ne modifie pas le nom du fichier pour être ASSO_Conducteur_Date

C'était si logique au lieu de mettre mon code dans un module, je l'ai lis directement dans la procédure

Private Sub Workbook_Open()
end sub

Et Hop le fichier est bien enregistre dans le bon sous dossier et avec bon nom de fichier et mon fichier d'origine n'est pas modifier

Merci pour l'aide

Avec cette ligne :

If Dir(stChDir, vbDirectory) = " & folder" Then

tu compare le nom du répertoire contenu dans ta variable stChdir avec la chaîne de caractère : "& folder" , ... comparaison qui n'as aucun sens .. supprime la ..

C'est déjà fait et j'ai toujours quand j'ouvre le fichier qui se trouve dans le dossier DOCUMENTS\TOTO\fichier.xlsm cette erreur

Le fichier s'ouvre il fait une sauvegarde sous mais au lieu de faire la sauvegarde dans le dossier :

DOCUMENTS\TOTO\ENTREPRISE\ASSO_CONDUCTEUR_date.xlsm

Il me fait la sauvegarde sous DOCUMENTS avec le même nom de fichier à savoir fichier.xlsm donc j'ai

DOCUMENTS\fichier.xlsm ==> fichier actuel

DOCUMENTS\TOTO\fichier.xlsm ==> fichier origine

alors que cela devrai être :

DOCUMENTS\TOTO\fichier.xlsm ==> fichier origine

DOCUMENTS\TOTO\ENTREPRISE\ASSO_CONDUCTEUR_date.xlsm ==> fichier actuel

Merci pour aide

Edit: Si je ne met rien dans thisworkbook et qu'on suite j’exécute ma macro le fichier est bien sauvegarde.

Donc pourquoi quand je met dans thiswoorkbook ma macro enregistre dans DOCUMENTS alors que le fichier se trouve dans DOCUMENTS\TOTO\

et pourquoi il te reste encore des lignes du genre :

Application.ActiveWorkbook

tu n'as pas besoin d'ActiveWorkBook ... utilise seulement ThisWorkbook ...

je comprends pas pourquoi tu as besoin de 2 variables pour ton répertoire : folder et stChDir ?? t

avec toutes ces variables il doit y avoir une erreur dans le calcul du nom de dossier destinataire, verifie celui-ci en l'affichant avec un msgbox par exemple..

Bonjour,

 Sub SaveAs()

        Dim nomfichier As String
        Dim NomCompletFichier As String
        Dim Entreprise As String
        Dim ASSO As String
        Dim Conducteur As String
        Dim fso
    Dim folder As String
Dim NomRep As String

      Entreprise = Range("Entreprise").Value
    ASSO = Range("ASSO").Value
    Conducteur = Range("Conducteur").Value

 NomRep = ThisWorkbook.Path
folder = NomRep & "\" & Entreprise   'Entreprise ma variable
'
Set fso = CreateObject("Scripting.FileSystemObject")
If fso.FolderExists(folder) Then
Shell "Explorer.exe " & folder
 MsgBox "dossier d'enregistrement existe  " & folder
Else
MkDir folder
 End If

     nomfichier = ASSO & "_" & Conducteur & "_"

        'Pour les tests, on ajoute l'heure au nom de fichier ; ainsi, il n'y a pas de doublon de noms
       Dim stHeureExport As String
        stHeureExport = "_" & _
            Format(Hour(Time), "00") & "" & Format(Minute(Time), "00") & "" & _
            Format(Second(Time), "00")
        NomCompletFichier = folder & Application.PathSeparator & nomfichier & stHeureExport '
      Workbook.SaveAs Filename:=NomCompletFichier

        MsgBox "le fichier a été enregistré sous le nom : " & vbCrLf & NomCompletFichier 

    End Sub

SI j’exécute cetet macro avec un bouton dans une feuille du classeur,

La sauvegarde sous se fait bien dans le bon dossier parce que ThisWorkbook.Path donne DOCUMENTS\TOTO\

Par contre c'est quand je met exécution de ce code que cela ne marche pas :

Private Sub Workbook_Open()

If IsEmpty(Range("ConditionsAccepter").Value) Then

SaveAs

 End If
 If Range("ConditionsAccepter") <> "Accepté" Then OuvertureFichier.Show
MiseAjourCouleur

Dans ce code Open si la cellule ConditionsAccepter n'est pas vide alors rien se passe est c'est OK vu que le fichier dû être déjà sauvegarde sous à sa première ouverture vu que la cellule ConditionsAccepter n'est pas vide.

Donc c'est quand cette cellule est vide que cela ne marche pas comme il faut car l’exécution de la macro SaveAs prend ici le dossier d'origine DOCUMENTS au lieu de DOCUMENTS\TOTO.

Est-ce que cela viens de cette ligne :

 
 NomRep = ThisWorkbook.Path
folder = NomRep & "\" & Entreprise
 nomfichier = ASSO & "_" & Conducteur & "_"
NomCompletFichier = folder & Application.PathSeparator & nomfichier & stHeureExport '

          [b]ThisWorkbook.SaveAs Filename:=NomCompletFichier[/b]