Enregistrer feuille & renommer si existe

Bonjour,

J'aimerais enregistrer via une macro une feuille de mon classeur. (en xlsx)

Je voudrais vérifier en premier si le dossier existe si pas le créer (le dossier est égal à : Year(Date)) donc l'année..

Ensuite vérifier si le fichier existe si c'est le cas le renommer en y ajoutant un "_1" voir "_2" etccc .

Cependant si il renomme le fichier avec un "_1" il faudrait qu'il vérifie si il existe .

Voici comment je procède dans mon programme :

Pour le dossier :

Je n'ai pas encore vraiment trouvé

Pour le fichier :

NomFich = chemin & nomfichier

If NomFich <> "" Then MsgBox "LeFichier Existe"

Application.ScreenUpdating = False

ThisWorkbook.ActiveSheet.Copy

With ActiveWorkbook

.SaveAs FileNAME:=chemin & Application.PathSeparator & nomfichier

.Close

End With

Mon programme ci dessus n'est pas au top car il me dit que le fichier existe alors que c'est faux.

Et ma demande la plus difficile :

Je ne voudrais pas qu'il m'affiche systématiquement l'onglet que je veux sauvegarder , c'est l'histoire du "ActiveSheet.Copy" qui m'embête. Je voudrais rester sur la page principal

Merci pour votre aide

Eric

Bonjour

Il faut tester avec Dir qui renvoie une chaîne vide si pas trouvé

pour le dossier

if Dir(Dossier, vbDirectory)=""

pour le classeur

if Dir(Dossier &"\"Fichier)=""

en espérant que cela fonctionne sur MAC

Remplace

ThisWorkbook.ActiveSheet.Copy

par

ThisWorkbook.WorkSheets("NomFeuille").Copy

Bonjour Jefekoi le forum

bonjour Chris78 non les chemins de fichier sous mac c'est hd:dossier:fichier.xlsm

les anti slachs ne sont pas utilisés

enfin de mémoire

a+

Papou

Merci messieurs, je vais tester ça et je reviendrai vers vous

PS: Pritec si ça marche les slachs mais le mieux est de mettre ceci :

Application.PathSeparator

Comme ça c'est compatible PC et MAC

Bonjour,

Voici une piste à tester :

Sub Test()

    Dim Cls As Workbook
    Dim Chemin As String
    Dim PartieFich As String
    Dim Racine As String
    Dim Nom As String

    'adapter la racine du nom
    Racine = "MonClasseur"

    'défini le chemin
    Chemin = ThisWorkbook.Path & "\" & Year(Date) & "\"

    'si le dossier n'existe pas, le crée
    If Dir(Chemin, vbDirectory) = "" Then MkDir Chemin

    'la recherche est faite avec un tiret bas obligatoirement dans le nom (les classeurs retournés seront ceux qui contiennent ce tiret)
    PartieFich = "*_*.xls*"

    'le numéro le plus élevé avec 1 en plus est retourné pour le nommage du nouveau classeur (voir fonction "NomFichier()")
    Nom = NomFichier(Chemin & "\", PartieFich)

    'si aucune valeur n'est retournée, pas de classeur correspondant donc on commence avec la numérotation à "01"
    If Nom = "" Then Nom = Racine & "_01.xlsx" Else Nom = Racine & Nom & ".xlsx"

    'gèle
    Application.ScreenUpdating = False

    'affecte à la variable
    Set Cls = ThisWorkbook

    'copie de la feuille (ce qui provoque la créatgion d'un nouveau classeur car pas d'argument passé)
    ThisWorkbook.ActiveSheet.Copy

    With ActiveWorkbook

        .SaveAs Filename:=Chemin & Nom
        .Close

    End With

    'réaffiche le classeur
    Cls.Activate

    'rafraîchit
    Application.ScreenUpdating = True

End Sub

'construit le nom avec incrémentation du numéro
Function NomFichier(Chemin As String, Partie As String) As String

    Dim Tbl() As String
    Dim Nom As String
    Dim Num As Integer
    Dim Max As Integer
    Dim I As Integer

    Tbl() = Fichiers(Chemin, Partie)

    If Not Not Tbl Then

        For I = 1 To UBound(Tbl)

            If IsNumeric(Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)) Then

                Num = Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)

            End If

            If Num > Max Then Max = Num

        Next I

        NomFichier = Left(ThisWorkbook.Name, InStrRev(ThisWorkbook.Name, "_")) & "_" & Format(Max + 1, "00")

    End If

End Function

'récupère les classeurs correspondants
Function Fichiers(Chemin As String, Partie As String) As String()

    Dim TableauFichiers() As String
    Dim Fichier As String
    Dim I As Integer

    Fichier = Dir(Chemin & Partie)

    Do While (Len(Fichier) > 0)

        I = I + 1
        ReDim Preserve TableauFichiers(1 To I)
        TableauFichiers(I) = Fichier
        Fichier = Dir()

    Loop

    Fichiers = TableauFichiers()

End Function

Merci Theze je vais tester ça de suite

Oups, pas vu que c'est Excel Mac

le code donné ne fonctionnera pas

Pas grave, je vais essayé de l'adapter

Juste une erreur pour le moment :

J'ai réparer ce problème, il me reste juste à faire en sorte qu'il ne m'affiche pas l'onglet que je veux sauvegarder je vais tester avec l'idée de Chris

L'ensemble fonctionne bien sauf la partie :

'construit le nom avec incrémentation du numéro

Excel me dit en gros "Le fichier existe voulez vous l'écraser"

Dans la fonction "NomFichier()", la fonction Mid() extrait le numéro du fichier à l'aide de la fonction InStr() :

Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)

Il faudrait voir ce qu'extrait ce groupe de fonctions avec :

MsgBox Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)

Montre comment sont construits tes noms mais n'ayant pas de Mac, je ne suis pas sûr d'être d'une grande aide

Il ne tient pas en compte la condition vu qu'il ne m'affiche pas le message :

If IsNumeric(Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)) Then

MsgBox Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)

idem pour cette condition

If Not Not Tbl Then

MsgBox "je suis ici"

Bonjour,

Un lien à consulter impérativement pour Excel Mac.

https://www.rondebruin.nl/mac.htm

Cdlt.

Merci Jean-Eric je connaissais mais ce n'est pas ce lien qui va résoudre mon petit problème, ce forum "Made In France" est assez complet pour comprendre certaines choses .. mais pas tout la preuve je patine

A mon avis l'erreur vient de là :

Nom = NomFichier(Chemin, PartieFich)

'si aucune valeur n'est retournée, pas de classeur correspondant donc on commence avec la numérotation à "01"
    If Nom = "" Then Nom = Racine & "_01.xlsx" Else Nom = Racine & Nom & ".xlsx"

Nom n'est jamais vide à priori

Il te faudrait inverser les instructions afin que le MsgBox s'affiche :

MsgBox Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)
If IsNumeric(Mid(Tbl(I), (InStr(Tbl(I), "_")) + 1, InStr(Tbl(I), ".") - InStr(Tbl(I), "_") - 1)) Then

Testes ce que retourne la variable :

Msgbox Nom
If Nom = "" Then Nom = Racine & "_01.xlsx" Else Nom = Racine & Nom & ".xlsx"

Le premier il ne m'affiche rien et le second (voir capture d'écran)

Re,

Des éléments de réponse.

Mais excel 2016 Mac est différent de Excel Mac 2011 !...

Cdlt.

Bon finalement j'ai trouvé

Le but étant d'ajouter à la fin du nom du fichier un "compteur" afin de ne pas écraser mon fichier si il existe :

En gros voici ce que je voulais

monfichier_01.xlsx

monfichier_02.xlsx

monfichier_03.xlsx

monfichier_04.xlsx

Et tout simplement je fais une lecture du dossier avec en recherche des fichiers qui commencent par monfichier_

Pour l'exemple il me dit 4, suffit de renommer le fichier par 5

i=i+1

renom = Format(i, "00")

Monfichier="monfichier_" & renom & ".xlsx"

Voilà tout simplement.

Bonjour,

En gros voici ce que je voulais

monfichier_01.xlsx

monfichier_02.xlsx

monfichier_03.xlsx

monfichier_04.xlsx

Et tout simplement je fais une lecture du dossier avec en recherche des fichiers qui commencent par monfichier_

Pour l'exemple il me dit 4, suffit de renommer le fichier par 5

i=i+1

renom = Format(i, "00")

Monfichier="monfichier_" & renom & ".xlsx"

C'est exactement ce que fait mon code mais pour PC !