Enregistrer sous sans doublon Le sujet est résolu

Y compris Power BI, Power Query et toute autre question en lien avec Excel
Avatar du membre
Seb77
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 7 juin 2015
Version d'Excel : 2010

Message par Seb77 » 8 avril 2017, 20:18

Bonjour le forum,

j'ai un petit problème concernant l'enregistrement sous mais sans doublon, je m'explique :

J'ai un code VBA que j'ai trouvé sur le net qui me convient après quelques modifs à ma facon ;) qui crée un fichier excel, le renome, colle des données dedans, le sauvegarde à un endroit défini et le ferme

le code concerné est le suivant :
Sub AddNewWorkbook()


Dim xlApp As Excel.Application
Dim xlBook As Excel.Workbook
Dim xlSheet As Excel.Worksheet
Dim DernLigne As Integer
Dim madate

madate = Format(Date, "dd-mm-yyyy")
DernLigne = Range("A" & Rows.Count).End(xlUp).Row


    Sheets("feuil1").Visible = True
    Sheets("feuil1").Cells.Copy
    'On créer l'objet Excel
    Set xlApp = CreateObject("Excel.Application")
    'On défini le nombre d'onglets (ici 5)
    xlApp.SheetsInNewWorkbook = 1
    'On ajoute un classeur
    Set xlBook = xlApp.Workbooks.Add
    'On donne un nom au classeur
    xlBook.SaveAs ("C:\" & madate & ".xlsx") 'changer l'adresse de l'enregistrement
    'On rend le classeur visible
    xlApp.Visible = True
    'On créer l'objet onglet dans le nouveau classeur créé
    'Set xlSheet = xlBook.Worksheets(1)
    'On affecte un nom aux l'onglets
    'xlSheet.Name = madate
    xlBook.Save
    xlBook.Close
    
    Workbooks.Open Filename:="C:\" & madate & ".xlsx"  'a renomer quand chamgement de pc
    Sheets("Sheet1").Select
    Selection.PasteSpecial Paste:=xlPasteColumnWidths
    ActiveSheet.Paste
    
    With Workbooks(madate & ".xlsx")
        .Save
        .Close
    End With
    
    'On ferme l'application
    'xlApp.Quit
    Application.CutCopyMode = False
End Sub
Est-ce possible de modifier ce code pour que si le fichier existe déjà ça rajoute par exemple "(1)" dans le nom sans demander à l'utilisateur s'il veut le remplacer ou pas que ça se fasse automatiquement


Merci d'avance
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'171
Appréciations reçues : 448
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 9 avril 2017, 00:25

Bonsoir,

:D Je ne trouve pas vraiment rationnel ni judicieux de passer par la création d'une 2e instance d'Excel pour créer un classeur ! Mais libre à toi... !

Cordialement.
Avatar du membre
Seb77
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 7 juin 2015
Version d'Excel : 2010

Message par Seb77 » 10 avril 2017, 17:52

Bonjour,

désolé mais je ne sais pas ce qu'est la 2ème instance... J'ai juste récupéré ce code qui fonctionne pour moi :)

Si jamais tu as mieux n'hésite pas :D
M
MFerrand
Fanatique d'Excel
Fanatique d'Excel
Messages : 17'171
Appréciations reçues : 448
Inscrit le : 20 juillet 2015
Version d'Excel : 2010 FR

Message par MFerrand » 10 avril 2017, 21:51

Pas très compliqué à comprendre : tu serais en train de travailler sous Word, ou Powerpoint.... avec ce code tu ouvres Excel et tu y fais quelques opérations...
Etant sous Excel, déjà, avec ce même code, tu ouvres un 2e Excel ! Tu peux tester manuellement l'ouverture de deux instances d'Excel et constater en allant dans l'editeur VBA dans chacune que tu ne vois pas ce qui se trouve dans l'autre...

C'est pourquoi je disais que si le but était de créer un classeur, la méthode est quelque peu contournée :D , alors que créer un classeur dans ton Excel initial se faisait simplement avec :
Workbooks.Add
Cordialement.
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'740
Appréciations reçues : 703
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 10 avril 2017, 22:41

Bonjour,
Erreur sujet.
Cdlt.
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'740
Appréciations reçues : 703
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 10 avril 2017, 23:48

Re,
C'est de nouveau moi. ;;)
Essaie ainsi :
Option Explicit

Public Sub AddNewWorkbook()
Dim xlSheet As Worksheet
Dim strDate As String, strFullName As String
Dim n As Long

    With Application
        n = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .ScreenUpdating = False
    End With
    
    strDate = Format(Date, "dd-mm-yyyy")
    strFullName = "C:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    Set xlSheet = ActiveWorkbook.Worksheets("Feuil1")
    With xlSheet
        .Visible = True
        .Copy
    End With
    
    ActiveSheet.Name = strDate

    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With

    With Application
        .CutCopyMode = False
        .SheetsInNewWorkbook = n
    End With

End Sub
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Seb77
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 7 juin 2015
Version d'Excel : 2010

Message par Seb77 » 11 avril 2017, 18:54

Merci pour les réponses et les explications

J'ai pensé aussi à l’altérative de rajouter l'heure au nom du fichier c'est ce que j'ai fait

Pour le reste je vais essayer et reviendrais vers vous

merci
Avatar du membre
Seb77
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 7 juin 2015
Version d'Excel : 2010

Message par Seb77 » 23 avril 2017, 00:25

Bonjour,

désolé de répondre que maintenant mais j'ai été très occupé ces derniers temps :/

pour revenir à ton code Jean-Eric je pense qu'il sera beaucoup mieux que le mien comme l'a fait entendre MFerrand :D
n'ayant pas trop de temps pour vérifier tout ça avant ma présentation de mon programme j'ai une dernière chose que je me suis aperçu pour la sauvegarde
si c'était possible de choisir un autre chemin de sauvegarde si le premier n'est pas dispo et ça sans aucun message ou choix a faire par l'utilisateur, je m'explique :

en lançant la macro, le programme enregistre le nouveau fichier excel par exemple sur un lecteur H: (clé usb)
mais si celui-ci n'est pas connecté je voudrais que ça sauvegarde sur le C:
en gros = si la sauvegarde sur H: échoue alors sauvegarder sur C: (ce qui sera une sauvegarde sûr au 2èm cas)

Merci d'avance
Avatar du membre
Jean-Eric
Fanatique d'Excel
Fanatique d'Excel
Messages : 16'740
Appréciations reçues : 703
Inscrit le : 27 août 2012
Version d'Excel : 365 Personnel

Message par Jean-Eric » 23 avril 2017, 01:07

Bonjour,
Essaie ainsi :
Public Sub AddNewWorkbook()
Dim xlSheet As Worksheet
Dim strDate As String, strFullName As String
Dim n As Long

    With Application
        n = .SheetsInNewWorkbook
        .SheetsInNewWorkbook = 1
        .ScreenUpdating = False
    End With

    strDate = Format(Date, "dd-mm-yyyy")
    strFullName = "H:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    Set xlSheet = ActiveWorkbook.Worksheets("Feuil1")

    With xlSheet
        .Visible = True
        .Copy
    End With
    
    ActiveSheet.Name = strDate

    On Error GoTo err_Handler
    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With

exit_Handler:
    With Application
        .CutCopyMode = False
        .SheetsInNewWorkbook = n
    End With
    Exit Sub
    
err_Handler:
    strFullName = "C:\" & Format(Now, "yyyymmdd hh-mm") & ".xlsx"
    With ActiveWorkbook
        .SaveAs strFullName, 51
        .Close
    End With
    Resume exit_Handler
    
End Sub
Jean-Eric

Je ne réponds pas aux M.P. non sollicités.
Avatar du membre
Seb77
Membre habitué
Membre habitué
Messages : 119
Inscrit le : 7 juin 2015
Version d'Excel : 2010

Message par Seb77 » 23 avril 2017, 18:34

Bonjour,

J'ai essayé ton code Jean-Eric il fonctionne beaucoup mieux que le mien ^^

Cependant il y a un petit problème et je ne sais pas d'où cela peut provenir, c'est le message suivant :
aqFMpyO.jpg

Comment puis-je faire pour pas que ce message s'affiche??

merci d'avance
Répondre
  • Sujets similaires
    Réponses
    Vues
    Dernier message