Microsoft 365 Enregistrer via VBA sans ouvrir fichier

[cdric78]

Bonjour,

J'ai créer cette macro pour actualiser une autre fichier.
La macro ouvre le fichier de destination, effectue des copies de données, enregistre et ferme le fichier de destination.

Fichier Source : "Fichier Gestion.xlsm" (dans lequel se trouve la macro)
Fichier Destination : Gestion_ Teams.xlsx

Je souhaite savoir s'il est possible de réaliser les mêmes étapes sans devoir ouvrir et fermer le fichier de destination car ces actions font "clignoter" mes fichiers Excel.

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
Workbooks.Open Filename:="C:\Users\CE\OneDrive - Truck\PAE\Gestion_ Teams.xlsx", _
                       UpdateLinks:=True

    Workbooks("Fichier Gestion.xlsm").Activate
    Range("D3:D500").Select
    Application.CutCopyMode = False
    Selection.Copy
    Workbooks("Gestion PAE _ Teams.xlsx").Activate
    Range("D3").Select
    Selection.PasteSpecial Paste:=xlPasteAllMergingConditionalFormats, Operation _
        :=xlNone, SkipBlanks:=False, Transpose:=False
    
    
            ActiveWorkbook.Save
    ActiveWindow.Close
    
        Workbooks("Fichier Gestion.xlsm").Activate
        Range("B1").Select
End Sub

Merci par avance

 

[Nain porte quoi]

Hello,

ça "clignote" parce que vous faites des sélections et que vous ne masquez pas les actions.
Une solution sans sélection mais qui est identique en terme de fonctionnalité (non testé)

Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
    
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
    
    Const Fichier_Source As String = "Fichier Gestion.xlsm"
    Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
    
    Application.ScreenUpdating = False

    Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True

    Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
    Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats

    Workbooks(Fichier_Destination).Save
    Workbooks(Fichier_Destination).Close
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
    
End Sub

 

[cdric78]

Bonjour Nain porte quoi,

Merci beaucoup pour cette proposition qui fonctionne parfaitement.
Je dois avouer qu'étant donné mon faible niveau en VBA, j'avais en partie utilisé la fonction enregistrement.

Encore merci pour ton aide.

 

[cdric78]

Bonjour,

Suite à l'aide de @Nain porte quoi, j'ai bien avancé mais je rencontre désormais un autre problème.
Mes fichiers sont stockés sur un Sharepoint et le code VBA fonctionne pour moi mais pour mon collègue car le code point vers mon C:\.
Je me demandais s'il serait possible d'enchaîner deux fois mon code avec les chemins de chaque C:\.

Voici mon idée, mais je ne sais pas si cela peut fonctionner et surtout je ne sais pas comment écrire le code pour faire un test.
Voici à quoi cela pourrait ressembler :

VB:
Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

'Utilisateur 1 (CE)
    Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
  
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
  
    Const Fichier_Source As String = "Fichier Gestion.xlsm"
    Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
  
    Application.ScreenUpdating = False

    Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True

    Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
    Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats

    Workbooks(Fichier_Destination).Save
    Workbooks(Fichier_Destination).Close
  
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  
  
  
'Utilisateur 2 (BV)
    Const Nom_Chemin As String = "C:\Users\BV\OneDrive - Truck\PAE\"
  
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
  
    Const Fichier_Source As String = "Fichier Gestion.xlsm"
    Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
  
    Application.ScreenUpdating = False

    Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True

    Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
    Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats

    Workbooks(Fichier_Destination).Save
    Workbooks(Fichier_Destination).Close
  
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  
  
End Sub

Merci par avance pour vos retours.

 

[Nain porte quoi]

Hello,

s'il n'y a que ça qui change, modifiez la ligne

    Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"

en

    Dim Nom_Chemin As String
    Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"

 

[cdric78]

Bonjour Nain porte quoi,

Merci pour cette nouvelle proposition qui me semble fonctionnelle. J'ai ajouté ce morceau de code et ça fonctionne toujours mais je n'ai pas eu la possibilité de tester sur la session de mon collègue qui est absent.

    Dim Nom_Chemin As String
    Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"

J'ai donc désormais ce code:

Private Sub Workbook_AfterSave(ByVal Success As Boolean)

    Dim Nom_Chemin As String
    Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"
  
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination As String = "Nom_de_la_Feuille_destination"
  
    Const Fichier_Source As String = "Fichier Gestion.xlsm"
    Const Feuille_Source As String = "Nom_de_la_Feuille_contenant_les_données_à_copier"
  
    Application.ScreenUpdating = False

    Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True

    Workbooks(Fichier_Source).Worksheets(Feuille_Source).Range("D3:D500").Copy
    Workbooks(Fichier_Destination).Worksheets(Feuille_Destination).Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats

    Workbooks(Fichier_Destination).Save
    Workbooks(Fichier_Destination).Close
  
    Application.CutCopyMode = False
    Application.ScreenUpdating = True
  
End Sub

Je viens de constater un autre problème concernant la copie de la colonne D (Range("D3 : 500") qui ne fonctionne pas si le fichier de destination n'est pas ouvert.

En théorie la VBA est lancée à l'enregistrement du fichier source. La VBA est doit ouvrir le fichier de destination, copie les données (données avec lien hypertexte), enregistré et fermé le fichier de destination.

En l'état si les deux fichiers sont ouverts, alors la VBA fonctionne et fini mettre les données à jours puis par fermé le fichier de destination.
Vois-tu un problème qui pourrait expliquer cela dans le code car je ne vois pas où est le problème.

Sachant que que je passe par cette VBA pour copier les datas qui sont des lien hypertexte étant que je n'arrive pas à copier les liens hypertexte via de la référence circulaire.

Merci par avance.

 

[Nain porte quoi]

la copie de la colonne D (Range("D3 : 500") qui ne fonctionne pas si le fichier de destination n'est pas ouvert.

Heum, je me suis basé strictement sur votre code et pour moi le fichier EST ouvert car vous utilisez Workbooks("Fichier Gestion.xlsm").Activate

Vois-tu un problème qui pourrait expliquer cela dans le code car je ne vois pas où est le problème.

C'est quoi le problème concrètement ?
N'oubliez pas que je ne vois pas par dessus votre épaule, que je ne connais pas votre job ni votre environnement de travail ni etc etc

Sachant que que je passe par cette VBA pour copier les datas qui sont des lien hypertexte étant que je n'arrive pas à copier les liens hypertexte via de la référence circulaire.

Alors là désolé, je ne comprend pas la phrase

 

[cdric78]

Bonjour Nain porte quoi,

Je suis désolé de ne pas avoir été clair. Je vais essayer d'expliquer le plus correctement possible.

- J'ai un Fichier Source "Fichier Gestion.xlsm" qui contient le code VBA.

- J'ai un Fichier Destination "Gestion_ Teams.xlsx".

- Le Fichier Source "Fichier Gestion.xlsm" alimente le fichier Fichier Destination "Gestion_ Teams.xlsx".

- Indépendamment du code VBA j'alimente une partie des champs via une formule de renvoi (Fichier Source B3 = Fichier Destination B3 etc...)

- J'utilise le code VBA pour gérer la copie de la colonne D car via la formule le lien hypertexte est absent du Fichier Destination "Gestion_ Teams.xlsx".
Je pense qu'il faudrait supprimer les filtres dans les 2 fichiers avant de lancer la copie de la colonne D car visiblement ça fonctionne mail lorsqu'un filtre est présent.

- Les deux fichiers sont stockés sur un Sharepoint (Teams) mais pas dans le même répertoire. Le code utilise un emplacement du lecteur "C:\ mais qui se synchronise correctement sur Teams. J'utilise cette partie du code afin que mon collègue puisse également utiliser le fichier XLSM

 Dim Nom_Chemin As String
    Nom_Chemin = Environ("USERPROFILE") & "\OneDrive - Truck\PAE\"

- Le but est de partager le Fichier Destination "Gestion_ Teams.xlsx" via Teams pour d'autres utilisateurs en mode lecture et que les données soient synchronisés en permanence.

- A l'utilisation, le but est de ne pas ouvrir manuellement le Fichier Destination "Gestion_ Teams.xlsx" . Le Fichier Source "Fichier Gestion.xlsm" est ouvert et l'enregistrement du Fichier Source "Fichier Gestion.xlsm" doit générer la mise à jour du Fichier Destination "Gestion_ Teams.xlsx"

- Le but final est d'avoir un Fichier Destination "Gestion_ Teams.xlsx" synchronisé sur un Sharepoint (Teams)

Avec la version du code actuel, je constate que:
--> Le code fonctionne correctement si les 2 fichiers sont ouverts. Après un enregistrement du Fichier Source "Fichier Gestion.xlsm" les données de la colonne D se mettent à jours dans le Fichier Destination "Gestion_ Teams.xlsx" et le Fichier Destination "Gestion_ Teams.xlsx" se ferme

--> Le code ne fonctionne pas si je le Fichier Source "Fichier Gestion.xlsm" est ouvert et que le Fichier Destination "Gestion_ Teams.xlsx" est fermé. Je constate aucune mise à jours des données de la colonne D dans le Fichier Destination "Gestion_ Teams.xlsx"

J'ai préparé deux fichiers exemples sans les datas pro.

Pour finir, a terme je vais avoir besoin d faire la même chose avec un deuxième onglet dans chaque fichier.

Encore merci @Nain porte quoi pour le temps consacré à mon sujet.

Cdric78

 

[Nain porte quoi]

Hello,

voici la version corrigée, mais je ne comprend pas bien le problème des liens hypertextes et du coup, vu qu'il y a des copies à faire, pourquoi ne pas tout copier en remplacement des formules de calculs qui sont plus lentes.

Option Explicit

Private Sub Workbook_AfterSave(ByVal Success As Boolean)
    
    Application.ScreenUpdating = False
    
    ' def de la source (qui est le fichier actuel)
    Const Fichier_Source As String = "Fichier Gestion.xlsm"
    Const Feuille_Source As String = "SUIVI OPTION"
    Dim WS_Source As Worksheet
    Set WS_Source = Workbooks(Fichier_Source).Worksheets(Feuille_Source)
    
    ' affiche toutes les données source
    If WS_Source.FilterMode = True Then WS_Source.ShowAllData
    
    ' def de la destination
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination As String = "BM"
    
    ' ouvre le fichier destination
    Const Nom_Chemin As String = "C:\Users\CE\OneDrive - Truck\PAE\"
    Workbooks.Open Filename:=Nom_Chemin & Fichier_Destination, UpdateLinks:=True

    Dim WS_Destination As Worksheet
    Set WS_Destination = Workbooks(Fichier_Destination).Worksheets(Feuille_Destination)
    
    ' affiche toutes les données du fichier destination
    If WS_Destination.FilterMode = True Then WS_Destination.ShowAllData


    ' copy les données de D3 à la dernière ligne de la colonne D
    Dim Der_Ligne
    Der_Ligne = WS_Source.Range("D" & Rows.Count).End(xlUp).Row
    WS_Source.Range("D3:D" & Der_Ligne).Copy
    
    ' colle les données dans la classeur destination
    WS_Destination.Range("D3").PasteSpecial , Paste:=xlPasteAllMergingConditionalFormats

    ' enregistre et ferme le fichier destination
    Workbooks(Fichier_Destination).Close SaveChanges:=True
    
    Application.CutCopyMode = False
    Application.ScreenUpdating = True

End Sub

 

[cdric78]

Bonjour Bonjour Nain porte quoi,

Merci pour cette dernière proposition.

Pour répondre à différents problèmes j'ai finalement opté pour copier l'intégralité des données via VBA.

Je rencontre désormais une autre difficulté pour réaliser les mêmes opérations sur une 2ème onglet mais je n'arrive pas à enchaîner les actions.
J'ai tout d'abord modifié la partie "def de la destination" de la manière suivante:

    ' def de la destination
    Const Fichier_Destination As String = "Gestion_ Teams.xlsx"
    Const Feuille_Destination_BM As String = "BM"
    Const Feuille_Destination_SUFO As String = "SUFO"

J'ai voulu ajouter les actions en lien avec l'onglet de destination "SUFO" juste avant la partie "enregistre et ferme le fichier destination" mais cela ne fonctionne pas malgré de nombreux essai :-( .

Pour finir, je me demande comment je pourrais faire pour éventuellement passer de cet Workbook_AfterSave vers un lancement du code de synchronisation à heure fixe (par exemple 10h + 16h) ou bien genre tous les 4 heures.

Si tu peux m'aider pour ces dernières étapes, cela serait vraiment sympa.
Dans tous les cas, @Nain porte quoi , je te remercie pour le temps déjà passé sur mon sujet.

Cdric78