Extraire une parti du nom du fichier actif

Le 21/08/2020 à 17:27

Bonjour

mon activeworkbook étant actif, puis je et comment en extraire une opartie du nom pour m'en reservir plu sloin pour renommer sa sauvegarde ?

Je m'explique

Fichier BdD_1005ED2306.xlsm est son nom

en cours de programme, je vais faire une sauvegarde de lui à un état différent et je voudrais la nommer BdD_1005ED2306_mofifié_JJHH.xlsm

ou JJHH sont écrits ainsi

ActiveWorkbook.SaveAs "\\Station-serveur\Sauvegarde\ BdD_1005ED2306 modifié le" & Format(Now(), "mmdd-hhmm") & ".xlsm"

avec la dedans la partie BdD_1005ED2306 venant d"'une variable.

Ex

nom_or= qqchose comme "partie gauche de x caractères du nom du fichier", ce qui suppose de savoir extraire le niom du fichier qui contient le code sou sforme de variable "var" par exemple et donc ouvoir écrire

ActiveWorkbook.SaveAs "\\Station-serveur\Sauvegarde\ "&var"& "modifié le" & Format(Now(), "mmdd-hhmm") & ".xlsm"

Vous voyez mon besoin ?

Le 21/08/2020 à 17:38

Bonjour Polygos,

Le traitement d'une chaîne de caractère est une des bases du développement

Voici un code

Sub Sauvegarde()
  Dim sNomFic As String, sNomSauv As String, sPath As String
  ' Chemin du fichier
  sPath = ActiveWorkbook.Path & "\"
  ' Nom du fichier
  sNomFic = ThisWorkbook.Name
  ' Nom de sauvegarde
  ' Récupérer la partie sans l'extension
  sNomSauv = Left(sNomFic, Len(sNomFic) - Len(".xlsm"))
  ' Ajouter ce que l'on veut
  sNomSauv = sNomSauv & " modifié le " & Format(Now(), "mmdd-hhmm") & ".xlsm"
  ' Créer la sauvegarde
  ActiveWorkbook.SaveAs sPath & sNomSauv
End Sub

@+

Le 21/08/2020 à 17:53

Bonjour,

Pour éviter de modifier le nom du classeur actif, il est préférable d'utiliser SaveCopyAs plutôt qu SaveAS.

Le 21/08/2020 à 17:54

Salut Patrice

Sauf s'il veut le garder actif

Le 21/08/2020 à 17:57

Dans ce cas il ne faut pas re-sauvegarder ....

Le 22/08/2020 à 07:04

Bonjour les gars

excellent !

Donc au debut du traitement j'ai ma sauvegarde, que je laisse active

Mais je voudrais la fermer, revenir au classeur avant sauvegarde car lui, je vais le sauvegarder à la fin sous un autre non (APRES traitement) et le laisser ouvert.

Comment puis je, après avoir sauvegardé le classeur à l'ouverture pour avoir la situation AVANT, le sauvegarder APRES traitement sous un autre nom ?

Le ActiveWorkbook.SaveAs sPath & sNomSauv 'sauvegarde du fichier, a sauvegardé la variable, mais pas fermé sauf que son nom à changé, je ne peux plus utiliser

sNomSauv = sNomSauv & " avant Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom

comme base du nouveau nom APRES les traitements, sinon je me trouve avec

GRANDE BASE Avant Imports PQ du 0822-0617 avant Import PQ du 0822-0617.xlsm après Import PQ du 0822-0618

Autre chose, je constate que le fichier d'origine, renommé avant Import PQ du 0822-0617.xlsm, donc celui qui s'appelle sNomFic (son vrai nom est GRANDE BASE 1008ED2108-1700.xlsm) n'est pas ouvert, pas visible et poyrtant verrouillé. Je ne peux pas revenir dessus.

Il aurait fallu le fermer mais comment l'appeler, il était activeworkbook, ce n'est plus lui qui est le activeworkbook à la fin du traitement

Sub MAJ_Generale_PQ()
'070620 création

    Dim sNomFic As String, sNomSauv As String, sPath As String 'déclarations pour garder le nom du fichier
    Dim k, ka, ks, ki, L As Integer
    Dim R As String
    Dim PB As String
    Dim DL As Long '(dernière ligne de la base)
    Dim PL As Long '8
    Dim DLT As Long '(dernière ligne du fichier transfert)
    Dim name As String
    Dim Import As String
    Dim store As String
    Dim Dc As Integer 'Dernière colonne de la base
    Dim plage As Range
    Dim ver As String
    Dim opeco As String
    Dim descoffre As String
    Dim priceadinfo As String
    ver = "160620"
    R = 0.2

' Déclaration des fichiers

    Dim wb1, wb2, wb3, wb4, wb5 As Workbook 
    Dim ws1, ws2, ws3, ws4, ws5 As Worksheet

    'Base de données
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Epicerie")
    ActiveWorkbook.SaveAs "\\Station-serveur\BDD\GRANDE BASE Avant Imports PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm"
    DoEvents
'    ActiveWorkbook.savechanges = False 'ne prend pas en compte les changements

'   Paramétrage du nom du fichier source
    sPath = ActiveWorkbook.Path & "\"   'chemin de stockage de la BAU
    sNomFic = ThisWorkbook.name    ' Nom du fichier
    sNomSauv = Left(sNomFic, Len(sNomFic) - Len(".xlsm")) ' récupération de la partie qui m'intéresse, ici, tout à gauche de xlsm
    sNomSauv = sNomSauv & " avant Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom
    ActiveWorkbook.SaveAs sPath & sNomSauv 'sauvegarde du fichier
    ' si j'avais pas voulu le garder actif, j'aurais mis : ActiveWorkbook.SaveCopyAs sPath & sNomSauv

  OUVERTURE DES 4 FICHIERS CIBLE – COPIE DES DONNEES SOURCES DEDANS, puis SAUVEGARDES des 4 modèles mis à jour et enregistrement du fichier source avec le nom adéquat (APRES mise à jour)

'SAUVEGARDES DES 4 FICHIERS MIS A JOUR DES STOCKS

With ws2 'Fichier de mise à jour PQ pour les deux sites de Cs_Cart
    ws2.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\CS-CART\TRANSFERTS DE DONNEES\PQ\Fichier MAJ PQ_FD_SV " & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws2.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws3 'Fichier de mise à jour PQ pour AMAZON_Fr
    ws3.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Fichiers chargés\MAJ Fichiers prix et quantités\FFPI-prix-qté " & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws3.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws4 'Fichier de mise à jour PQ pour SEVELLIA
    ws4.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\SEVELLIA\IMPORTS\PQ\MAJ PQ SEV (v" & ver & ")" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws4.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws5 'Fichier de mise à jour PQ pour INTERMARCHE
    ws5.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\INTERMARCHE\Fichier de stock\Imports\Offres\MAJ\MAJ PQ INTER (v" & ver & ")" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws5.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws1 ‘Sauvegarde de la BDD enrichie des dates de copie vers les classeurs cibles, sans fermer
    sNomSauv = sNomSauv & " après Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom
    ThisWorkbook.SaveAs sPath & sNomSauv

    DoEvents

End With

End Sub
Le 22/08/2020 à 08:12

Après petite modifications et ajustements:

Sub MAJ_Generale_PQ()
'070620 création

    Dim sNomFic As String, sNomSauv As String, sPath As String, sNomSauvor  As String 'déclarations pour garder le nom du fichier
    Dim k, ka, ks, ki, L As Integer
    Dim R As String
    Dim PB As String
    Dim DL As Long '(dernière ligne de la base)
    Dim PL As Long '8
    Dim DLT As Long '(dernière ligne du fichier transfert)
    Dim name As String
    Dim Import As String
    Dim store As String
    Dim Dc As Integer 'Dernière colonne de la base
    Dim plage As Range
    Dim ver As String
    Dim opeco As String
    Dim descoffre As String
    Dim priceadinfo As String
    ver = "160620"
    R = 0.2

' Déclaration des fichiers

    Dim wb1, wb2, wb3, wb4, wb5 As Workbook 
    Dim ws1, ws2, ws3, ws4, ws5 As Worksheet

    'Base de données
    Set wb1 = ThisWorkbook
    Set ws1 = wb1.Worksheets("Epicerie")
    ActiveWorkbook.SaveAs "\\Station-serveur\BDD\GRANDE BASE Avant Imports PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm"
    DoEvents
'    ActiveWorkbook.savechanges = False 'ne prend pas en compte les changements

'   Paramétrage du nom du fichier source
    sPath = ActiveWorkbook.Path & "\"   'chemin de stockage de la BAU
    sNomFic = ThisWorkbook.name    ' Nom du fichier
    sNomSauv = Left(sNomFic, Len(sNomFic) - Len(".xlsm")) ' récupération de la partie qui m'intéresse, ici, tout à gauche de xlsm
   sNomSauvor = sNomSauv ‘ va servir pour créer le nom après traitement
   sNomSauv = sNomSauv & " avant Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom
    ActiveWorkbook.SaveAs sPath & "Sauvegardes BDD avant Import\"  & sNomSauv 'sauvegarde du fichier dans un répertoire distinct
    ' si j'avais pas voulu le garder actif, j'aurais mis : ActiveWorkbook.SaveCopyAs sPath & sNomSauv

  OUVERTURE DES 4 FICHIERS CIBLES – COPIE DES DONNEES SOURCES DEDANS, puis SAUVEGARDES des 4 modèles mis à jour et enregistrement du fichier source avec le nom adéquat (APRES mise à jour)

'SAUVEGARDES DES 4 FICHIERS MIS A JOUR DES STOCKS

With ws2 'Fichier de mise à jour PQ pour les deux sites de Cs_Cart
    ws2.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\CS-CART\TRANSFERTS DE DONNEES\PQ\Fichier MAJ PQ_FD_SV " & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws2.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws3 'Fichier de mise à jour PQ pour AMAZON_Fr
    ws3.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\AMAZON\Fichier Exportés AMZ\Fichiers chargés\MAJ Fichiers prix et quantités\FFPI-prix-qté " & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws3.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws4 'Fichier de mise à jour PQ pour SEVELLIA
    ws4.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\SEVELLIA\IMPORTS\PQ\MAJ PQ SEV (v" & ver & ")" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws4.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws5 'Fichier de mise à jour PQ pour INTERMARCHE
    ws5.Copy
    ActiveWorkbook.SaveAs "\\Station-serveur\PARTENAIRES MD\INTERNET\MARKET PLACE\INTERMARCHE\Fichier de stock\Imports\Offres\MAJ\MAJ PQ INTER (v" & ver & ")" & name & "-" & Format(Now(), "mmdd-hhmm") & ".xlsx"
    DoEvents
    ws5.Activate
    ActiveWorkbook.Close savechanges:=False
End With

With ws1 ‘Sauvegarde de la BDD enrichie des dates de copie vers les classeurs cibles, sans fermer
    sNomSauv = sNomSauvor & " après Import PQ du " & Format(Now(), "mmdd-hhmm") & ".xlsm" 'création du nouveau nom
    ThisWorkbook.SaveAs sPath & sNomSauv

    DoEvents

End With

End Sub
Le 22/08/2020 à 10:32

Re,

Ce code ne fonctionne pas et il est totalement incohérent !

Si tu as un fichier principal, dont tu veux sauvegarder des éléments au fur et à mesure des évolutions, il ne faut pas procéder comme ça.

1) tu fait une copie du fichier avant modif, avec SaveCopyAS au lieu de SaveAs, pour que ton fichier principal reste actif.

2) tu fait les modifs

3) tu fait une copie du fichier après modif, toujours avec SaveCopyAS au lieu de SaveAs, pour que ton fichier principal reste actif

En procédant ainsi tu travailles toujours avec le même fichier principal.

Il faut que tu nettoies ce code (trop de variables inutilisées, mauvaises déclarations, ...)

Au lieu de répéter n fois des instructions similaires pour sauvegarder des feuilles, tu devrais écrire une sous-procédure ou une fonction.

Rechercher des sujets similaires à "extraire parti nom fichier actif"