Enregistrer sous un dossier modifier par une macro

[nonosto]

Chères amies, chers amis du forum

Je souhaite enregistrer un fichiers sans modifier le fichiers source grace saveascopy. Le probleme le fichier source est modifié par une macro, et j'esperais faire un saveascopy après le traitement puis revenir sur le fichier source avant modifications pour continuer la boucle.


Savez vous comment faire svp?

Merci

 

[camarchepas]

Re : Enregistrer sous un dossier modifier par une macro

Bonjour ,

Regardes par ici, un cas pas trés éloigné ,

Reviens par ici que tu es des difficultés ou pas pour nous dire .

https://www.excel-downloads.com/threads/sauvegarde-dun-fichier.222860/

 

[nonosto]

Re : Enregistrer sous un dossier modifier par une macro

Merci

Voici la routine que j'utilise:

Sub CreateNewFolder(ByVal TmpName As String)

Dim strDrive As String

Sheets("Control").Select
gvSTRPathSave = Sheets("Control").Range("B4").Value & "\"

    If Dir(gvSTRPathSave & TmpName & "_" & Format(Date, "dd_mm_yyyy"), vbDirectory) = "" Then
        strDrive = Left(gvSTRPathSave, 1)
        ChDrive strDrive
        ChDir gvSTRPathSave
        MkDir "Export" & "_" & Format(Date, "dd_mm_yyyy")
    End If
    
ActiveWorkbook.SaveCopyAs gvSTRPathSave & TmpName & "_" & Format(Date, "dd_mm_yyyy") & "\" & TmpName & "_" & Format(Date, "dd_mm_yyyy") & ".xlsm"

End Sub

Cependant cela ne produit pas ce que je souhaites, cela enregistre bien une copie du fichier modifier par la macro a l'endroit voulu au nom voulu, mais le fichiers source lui aussi est modifié.

Le bout de code de ma macro qui produit le traitement:

With Worksheets("BDD")
    For j = 2 To Ncol
        vntTmpVector = Application.Index(Application.Transpose(gvVNTArrayQueryData), j)
        strTmpName = CStr(vntTmpVector(1))
        vntTmpVector(1) = Empty
        gvVNTCriteriaVector = CreateCriteriaVector(dictReference)
        .Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter Field:=20, Criteria1:=Array(gvVNTCriteriaVector), Operator:=xlFilterValues
        .Range(.Cells(5, 1), .Cells(Nrow + 3, Ncol + 3)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter
        Application.Calculate
        Call CreateNewFolder(strTmpName)
    Next j
End With

 

[camarchepas]

Re : Enregistrer sous un dossier modifier par une macro

Ok , je pense comprendre ,

La macro modifie le fichier ouvert , cela veut dire qu'avant le traitement, il faut faire la sauvegarde par savecopyas , ouvrir ce classeur et faire le traitement sur ce classeur., ensuite une fermeture avec sauvegarde classique du fichier ouvert ,et cela te donneras à nouveau le classeur d'origine non modifié .
Le code est plutot simple , si tu es d'accord sur le principe, soit tu arrives à l'écrire toi même , soit tu reviens vers moi pour un coup de pouce

 

[nonosto]

Re : Enregistrer sous un dossier modifier par une macro

Merci

j'esperais eviter la copy car on peut pas ecrire dans un fichier fermé, et l'ouverture et la fermeture + traitement sa fais lourd. Naïvement j’espérais que le savecopyas ferais un enregistre sous et m'evitere cette recharge de calcule.

Peux tu me donner les grande ligne du code et les fonction a utliser STP?

Merci

 

[camarchepas]

Re : Enregistrer sous un dossier modifier par une macro

Alors ,

Voici le code selon moi pour réaliser ce travail .

Testé partiellement puisque pas de jeu de données de test.

Les modifications ne sont pas trés importantes

Function CreateNewFolder(ByVal TmpName As String) As String
Dim Nom_Complet As String
Dim strDrive As String

Sheets("Control").Select
gvSTRPathSave = Sheets("Control").Range("B4").Value & "\"

    If Dir(gvSTRPathSave & TmpName & "_" & Format(Date, "dd_mm_yyyy"), vbDirectory) = "" Then
        strDrive = Left(gvSTRPathSave, 1)
        ChDrive strDrive
        ChDir gvSTRPathSave
        MkDir "Export" & "_" & Format(Date, "dd_mm_yyyy")
    End If
Nom_Complet = gvSTRPathSave & TmpName & "_" & Format(Date, "dd_mm_yyyy") & "\" & TmpName & "_" & Format(Date, "dd_mm_yyyy") & ".xlsm"
ActiveWorkbook.SaveCopyAs Nom_Complet
CreateNewFolder = Nom_Complet
End Function
Sub traitement()
'Traitement des données
Dim Nom_Classeur As String
Dim Fichier As String
'Préparation du classeur final

Nom_Classeur = CreateNewFolder(strTmpName)
Workbooks.Open Filename:=Nom_Classeur
Fichier = ActiveWorkbook.Name
With ActiveWorkbook.Worksheets("BDD")
    For j = 2 To Ncol
        vntTmpVector = Application.Index(Application.Transpose(gvVNTArrayQueryData), j)
        strTmpName = CStr(vntTmpVector(1))
        vntTmpVector(1) = Empty
        gvVNTCriteriaVector = CreateCriteriaVector(dictReference)
        .Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter Field:=20, Criteria1:=Array(gvVNTCriteriaVector), Operator:=xlFilterValues
        .Range(.Cells(5, 1), .Cells(Nrow + 3, Ncol + 3)).SpecialCells(xlCellTypeVisible).EntireRow.Delete
        .Range(.Cells(4, 1), .Cells(4, 1).End(xlToRight)).AutoFilter
        Application.Calculate
        
    Next j
    
End With
'Sauvegarde et Ferme le classeur de travail
Workbooks(Fichier).Close True
' Le classeur source reprend la main
End Sub

 

[nonosto]

Re : Enregistrer sous un dossier modifier par une macro

Merci beaucoup cela marche, cependant comme prévu c'est lent, de plus Application.calculate plante systématiquement.

Pourtant j'ai bien mis au debut et a la fin de ma macro:

Application.ScreenUpdating = False
Application.Calculation = False
Application.EnableEvents = False

.....

Application.ScreenUpdating = True
Application.Calculation = True
Application.EnableEvents = True

Pour calculate je crois qu'il recalcule toute les feuille des deux worksheets ouvert, y a til un moyen de cible que le worksheet dont on a besoin de lancer les calcul.

De plus exite il une instruction qui cacherait la feuille creer avec savecopyas pendant le traitement pour gagner en efficacite?

Merci

 

[Pierrot93]

Re : Enregistrer sous un dossier modifier par une macro

Bonjour,

pour arrêter le calcul auto :

 Application.Calculation = xlCalculationManual

pour le rétablir :

 Application.Calculation = xlCalculationAutomatic

bonne journée
@+

 

[camarchepas]

Re : Enregistrer sous un dossier modifier par une macro

Nono pour le temps ,

Reste à voir , mais tu pourrais embarquer la macro dans un classeur indépendant de celui des données initiales ne comportant que le code.
ainsi tu pourrais
lancer ton traitement
ouverture tu 1° classeur avec les données initiales
modification éventuelle des données
sauvegarde par copie
fermeture du classeur données initiales
ouverture classeur copié
Réalisation traitement des données en prenant en compte la remarque de @ Pierrot que je salus au passage
sauvegarde du résultat obtenu
et si besoin rechargement du classeur initial.

Voilà en 2 jet cette 2 eme solution .

Bon , plus on connait le sujet de pres et plus des solutions s'imposent . peut être que l'on est pas du tous sur la bonne voie

l'on pourrait peut être travailler sur 2 onglets pour les données ?

Mais là , c'est toi qui à la connaissance de ce qu'il y a au départ et de ce que l'on veut obtenir à la fin

 

[nonosto]

Re : Enregistrer sous un dossier modifier par une macro

Merci

Pierrot 93, il y a une différence entre sa:

Application.Calculation = False

et sa:

Application.Calculation = xlCalculationManual

.

Camarchepas, ton idée est carrement canon je me demande comment je n'yai pas pensé avant , delocalisé la macro.
En effet je n'ai besoin du fichiers source que pour la copie, le traitement se fais ensuite sur le fichier generer.

Thanks you

 

[Pierrot93]

Re : Enregistrer sous un dossier modifier par une macro

Re,

Pierrot 93, il y a une différence entre sa:

tu disais avant :

de plus Application.calculate plante systématiquement.

tu as testé la différence ? toujours une erreur ou pas ? perso préfère utiliser les bonnes constantes / valeurs dans les instructions....