Macro pour reprendre le focus sur son classeur et le fermer

Bonjour à toutes et tous,

Je voudrais utiliser cette macro pour fermer le fichier en cours et lancer la macro d'un autre fichier afin de le déplacer. Je ne sais pas par quoi je dois remplacer 'ThisWorkbook.name ou autre pour me repositionner sur mon classeur.

Sub LanceMacroDeplaceFichier()
    'ThisWorkbook.Name
    ActiveWorkbook.Close savechanges:=False
    Application.Run "DONNEES.xlsm!Module1.DeplaceFichier"
End Sub

Je précise que je lance différentes macros pour ajouter des données et autres dans d'autres classeurs donc je perds le focus sur mon classeur. Je ne peux pas mettre en dur le nom du fichier car il varie à chaque utilisation. ex: FAC-40-DUPONTJEAN-S2-2023.xlsm ou FAC-70-DURANTRENE-S4-2023.xlsm, etc...

D'avance merci pour votre aide.

Bonjour

même sujet qu'ici --> ici ?? Si oui pourquoi ouvrir un nouveau fil de discussion ?

Je ne sais pas par quoi je dois remplacer 'ThisWorkbook.name ou autre pour me repositionner sur mon classeur.

Pas sûr d'avoir compris ce que vous voulez faire ....

Pourquoi ne faites vous pas comme ceci

Sub LanceMacroDeplaceFichier()
    Application.Run "DONNEES.xlsm!Module1.DeplaceFichier"
    ThisWorkbook.Close savechanges:=False
End Sub

Cordialement

Bonsoir Dan,

Je m'excuse d'avoir agit ainsi mais je ne savais pas comment remonter mon sujet car visiblement il n'intéressait personne. Si le premier sujet est gênant je suppose qu'en tant que modérateur vous avez peut être la possibilité de le supprime. Je m'excuse auprès de vous et de la communauté.

Concernant votre proposition, j'ai bien essayé de le reproduire mais votre macro est dans le fichier qui doit être déplacé, donc impossible de le déplacer si pas fermé.

A ce jour, nous utilisons un bouton placé sur le classeur DONNEES pour lancer les différentes macros comme ci-après. Je peux m'affranchir de la première en fermant moi même le fichier.

Sub FermeFactureEnCours()
On Error Resume Next

Set AppExcel = GetObject(, "Excel.Application")

If Err.Number <> 0 Then
        Set AppExcel = CreateObject("Excel.Application")
End If

Err.Clear

On Error GoTo 0
Dim w As Workbook
Dim Fichier As String

Fichier = Range("C34").Value

For Each w In AppExcel.Workbooks
If w.Name = (Fichier) Then
w.Save
w.Close
End If
Next
Call TesteSiDossierExiste
End Sub

Sub TesteSiDossierExiste() 'Teste si le dossier année existe dans le dossier ARCHIVES FACTURE
Dim Chemin As String
Dim DossierCellule As String 'Dossier a créer ou pas
Dim NomDossier As String 'Répertoire où doit être créer le dossier
Dim Output As Integer 'pour le dernière MsgBox
Dim Année

Année = Year(Now())
DossierCellule = "C:\FACTURE\ARCHIVES FACTURES\"
NomDossier = Année
Chemin = DossierCellule & NomDossier & "\"

    If Dossier(Chemin) = True Then
        'MsgBox "CLIQUEZ sur le bouton [OK] pour ARCHIVER LA FACTURE !!!"
    Else
            If MsgBox("   Le dossier pour sauvegarder les FACTURES EN COURS n'existe pas..." & Chr(10) & Chr(10) & "   Souhaitez-vous le créer ?", 4 + 64, "Création du dossier...") = vbYes Then
               MkDir (Chemin)
               Output = MsgBox("   Votre dossier a été créé, CLIQUEZ sur le bouton [OK) pour archiver la facture !!!", 0 + 64, "Aux Cochons d'Ausson ...")
            Else
    Exit Sub
            End If
    End If

Call DeplacerFichier
End Sub

Sub DeplacerFichier() 'Fichier DONNEES

  Set fso = CreateObject("Scripting.FileSystemObject")
  SourcePath = ThisWorkbook.Worksheets("CHEMIN").Range("C35").Value
  destinationPath = ThisWorkbook.Worksheets("CHEMIN").Range("C31").Value
  fso.MoveFile SourcePath, destinationPath

End Sub

Il y a certainement mieux mais je n'ai que cela pour le moment. Je voulais simplement automatiser la tâche mais c'est pas évident.

Encore toutes mes excuses.

Cordialement

Bonjour

Je m'excuse d'avoir agit ainsi mais je ne savais pas comment remonter mon sujet car visiblement il n'intéressait personne. Si le premier sujet est gênant je suppose qu'en tant que modérateur vous avez peut être la possibilité de le supprime. Je m'excuse auprès de vous et de la communauté.

Ce n'était pas compliqué, il vous suffisait de refaire un post comme vous l'avez fait à 15h22 dans le fil en question

Je suis d'ailleurs allé relire votre fil et ce que vous vouliez faire. En fait votre souci est uniquement du au nom de votre fichier qui n'est pas correct.
Est-ce que je vous donne la solution sur le fil précédent ?

Pour votre demande ici :

A ce jour, nous utilisons un bouton placé sur le classeur DONNEES pour lancer les différentes macros comme ci-après. Je peux m'affranchir de la première en fermant moi même le fichier.

Quand je regarde votre fil précédent le bouton est placé dans le fichier facture et pas le fichier données. Quid ?

Bonjour,

Effectivement, j'aurais dû poursuivre dans le même post. Désolé.

Les macros sont lancées depuis le classeur DONNEES par l'intermédiaire du bouton comme ci-dessous étant que je n'arrive pas à fermer mon fichier FAC-40.....

Je suis intéressé par votre solution bien évidemment et vous pouvez me répondre dans ce fil.

Cordialement.

Edit Modo :

Les deux fichiers posté dans votre premier fil

edit : fichier supprimé pour données confidentielles

Encore moi

J'ai changé légèrement mes macros comme suit ...

Sub FermeFactureEnCours()
'Cette macro permet de fermer un fichier Excel et de le sauvegarder
On Error Resume Next  'Ignorer les erreurs

Dim AppExcel As Object 'objet qui va être créé
Dim w As Workbook 'variable pour la feuille de travail
Dim Fichier As String 'variable pour le nom du fichier

Set AppExcel = GetObject(, "Excel.Application") 'Récupérer l'objet Excel

If Err.Number <> 0 Then 'Si l'objet n'existe pas
        Set AppExcel = CreateObject("Excel.Application") 'Créer l'objet Excel
End If

Err.Clear 'Effacer les erreurs

On Error GoTo 0 'Ne pas ignorer les erreurs

Fichier = Range("C34").Value 'Récupérer le nom du fichier à partir de la cellule

For Each w In AppExcel.Workbooks 'Pour chaque feuille de travail
If w.Name = (Fichier) Then 'Si le nom de la feuille de travail est le même que celui du fichier
w.Save 'Sauvegarder la feuille de travail
w.Close 'Fermer la feuille de travail
End If
Next
Call TesteSiDossierExiste 'Appeler la macro TesteSiDossierExiste
End Sub

Sub TesteSiDossierExiste()
'Cette macro permet de tester si un dossier existe et de le créer s'il n'existe pas

Dim Chemin As String 'Chemin du dossier
Dim DossierCellule As String 'Chemin parent du dossier
Dim NomDossier As String 'Nom du dossier
Dim Output As Integer 'Variable pour le message de fin
Dim Année As Integer 'Variable pour l'année en cours

Année = Year(Now()) 'Récupérer l'année en cours
DossierCellule = "C:\FACTURE\ARCHIVES FACTURES\" 'Chemin du dossier parent
NomDossier = Année 'Nom du dossier
Chemin = DossierCellule & NomDossier & "\" 'Combiner le chemin du dossier parent et le nom du dossier

    If Dossier(Chemin) = True Then 'Si le dossier existe
        'MsgBox "CLIQUEZ sur le bouton [OK] pour ARCHIVER LA FACTURE !!!"
    Else 'Si le dossier n'existe pas
            If MsgBox("   Le dossier pour sauvegarder les FACTURES EN COURS n'existe pas..." & Chr(10) & Chr(10) & "   Souhaitez-vous le créer ?", 4 + 64, "Création du dossier...") = vbYes Then 'Demander si le dossier doit être créé
               MkDir (Chemin) 'Créer le dossier
               Output = MsgBox("   Votre dossier a été créé, CLIQUEZ sur le bouton [OK) pour archiver la facture !!!", 0 + 64, "Aux Cochons d'Ausson ...") 'Message de fin
            Else
    Exit Sub 'Quitter la macro
            End If
    End If

Call DeplacerFichier 'Appeler la macro DeplacerFichier
End Sub

Sub DeplacerFichier() 'Fichier DONNEES
'Cette macro permet de déplacer un fichier de sa source à sa destination

Dim fso As Object 'Variable pour le système de fichiers
Dim SourcePath As String 'Chemin de la source
Dim DestinationPath As String 'Chemin de destination

  Set fso = CreateObject("Scripting.FileSystemObject") 'Création de l'objet pour le système de fichiers
  SourcePath = ThisWorkbook.Worksheets("CHEMIN").Range("C35").Value 'Définir la source du fichier
  DestinationPath = ThisWorkbook.Worksheets("CHEMIN").Range("C31").Value 'Définir la destination du fichier
  fso.MoveFile SourcePath, DestinationPath 'Déplacer le fichier de sa source à sa destination

End Sub

Cordialement

J'ai replacé vos deux fichiers du fil précédent ici. A voir si cela sert

Les macros sont lancées depuis le classeur DONNEES par l'intermédiaire du bouton comme ci-dessous étant que je n'arrive pas à fermer mon fichier FAC-40.....

Ce que vous écrivez c'est différent là .... Le bouton se trouvait dans le fichier Facture et non dans le fichier données? (c'est ce que je vois dans votre fichier facture)

Si oui, en fait votre code Sub Close_File() dans le fichier donnees fonctionne très bien. Le souci est que le nom de votre fichier mentionné en cellule C34, n'est pas identique au nom du fichier à fermer. Raison du bug
Dans le fichier données remplacez le code Sub Close_File() par celui-ci

Option Compare Text
Sub Close_File()
Dim File_Path ' As String
File_Path = ThisWorkbook.Sheets(1).Range("C34").Value
On Error Resume Next
Workbooks(File_Path).Close SaveChanges = False
If Err.Number > 0 Then MsgBox "le fichier ne semble pas être ouvert ou de nom incorrect !", vbCritical: Exit Sub
MsgBox "Votre fichier a été fermé !!!", 64
End Sub

Faites un test et dites moi

Edit : oulàlà votre code posté là. Vous compliquez je pense. Puis pourquoi écrivez-vous cela puisque vous êtes dans excel ?

Set AppExcel = GetObject(, "Excel.Application")

Dans quel fichier se trouve Range("C34") et cette macro -->

Sub FermeFactureEnCours()

Je sais que je me complique la vie au regard du coup de main sur le userform où je voulais en faire une trentaine alors qu'il vous a fallu que quelques lignes, mais hélas pour moi je n'ai pas toutes les connaissances pour affronter EXCEL. Je vous fais passer les fichiers anonymiser pour plus de clarté et c'est certiainement une usine à gaz car j'avoue que je m'y perds dans tous ces codes.

Le projet fonctionne ainsi, je pars d'un CLASSEUR nommé FACTURE (sorte de modéle) où se trouve différents feuillets dont certains sont masqués.

Donc sur la facture qui a été générée avec un nouveau nom qui correspond au numéro de facture, lorsque nous cliquons sur le bouton Facture finie, il enclenche le lancement de plusieurs macros notamment:

FACTURE_FINIE

PDF_FACTURE

COPIERPLAGE qui copie une plage de cellules dans un autre fichier, cette même macro lance la macro

SUIVI_DES_FACTURES

et c'est à la fin de celle-ci que j'aurais voulu fermer cette facture et lancer les macros qui se trouve dans le classeur DONNEES que je joints également. (Je me trompe certainement de voie)

Dans ce dernier se trouve l'ensemble des macros qui me permettent de déplacer le fichier à l'endroit voulu. Je sais pertinemment que mon écriture, ma gestion du projet, etc... n'est pas top mais je ne peux pas faire mieux. J'essaye chaque jour de l'améliorer mais ce n'est pas facile.

J'ai testé votre bout de code dans les fichiers que vous avez remis dans le fil et cela fonctionne parfaitement.

J'ai transposé le tout dans les fichiers que je joints et il m'affiche une "erreur de compilation" "Variable non définie" sur le mot "SaveChanges" (6ème ligne)

Joli fichier !

Je viens de regarder. Il y a des choses à simplifier ou modifier. On va commencer par le fichier données :

Dans le module 1 ,
1 . vous avez un code Private Sub UserForm_Initialize(). A quoi sert ce code ?
2. le code Sub FermeFactureEnCours(), vous avez placé un boucle For Each w In AppExcel.Workbooks 'Pour chaque feuille de travail. Pouvez-vous expliquer l'idée ?

Merci.

1 / Je ne l'avais pas vu, il ne sert à plus rien. Cela m'a servi au tout début.

Par contre en C9, il y avait inscrit le chemin C:\FACTURE\ARCHIVES FACTURES\ lieu où sont déplacées les factures finies. En C33 il y a l'année en cours pour le sous dossier.

2/ le code n'est pas de moi. Il me semble que cela est inutile étant donné qu'il n'y a qu'un fichier à fermer. C'est comme juste au dessus le GetObject que vous m'avez fait remarqué ....

Je sens que cela va être compliqué.

Ne me reposter pas chaque fois votre fichier sinon on ne va pas s'y retrouver. J'ai votre fichier dont je me sers pour les modifications.

1 / Je ne l'avais pas vu, il ne sert à plus rien. Cela m'a servi au tout début.

Ok donc supprimez le.

1a. Par contre en C9, il y avait inscrit le chemin C:\FACTURE\ARCHIVES FACTURES\ lieu où sont déplacées les factures finies.

C9 ? je ne vois rien là
Pour le chemin, votre arborescence est donc chaque fois comme ceci ?
C:\FACTURE\ARCHIVES FACTURES\2022
C:\FACTURE\ARCHIVES FACTURES\2023

1b. En C33 il y a l'année en cours pour le sous dossier.

cela vient de A49 dans votre facture cette année. Là vous auriez peut être pu utiliser l'info en G9. A voir plus tard peut-être

2/ le code n'est pas de moi. Il me semble que cela est inutile étant donné qu'il n'y a qu'un fichier à fermer.

Ok on va voir ce que l'on peut arranger. Je ne comprends pas bien ce que vous voulez faire
Dans le code Close_file, vous fermez le fichier facture sans le sauver puis vous appelez la macro FermeFactureEnCours ?

3.

J'ai transposé le tout dans les fichiers que je joints et il m'affiche une "erreur de compilation" "Variable non définie" sur le mot "SaveChanges" (6ème ligne)

la ligne devrait être comme ceci --> Workbooks(File_Path).Close SaveChanges:=False. Il vous manque les : avant le signe =

Dites moi quand c'est ok sur les points ci-avant

OK, donc je travaille sur l'original le dernier que je vous ai envoyé.

Modification faites, le fichier se ferme mais il n'est pas encore déplacé. Par contre il ne m'affiche pas le message comme quoi le fichier a été fermé.

Il y a un bug dans votre dernier fichier. Je l'ai supprimé.
Donc vous pouvez me renvoyer celui que vous utilisez

1. Dans le code Sub TesteSiDossierExiste()

Si le dossier existe, vous sortez du code sans rien faire
Si le dossier n'existe pas, vous créez le répertoire

Juste ?

2. Vous appelez le code au point 1 depuis le bouton sur la feuille Chemin, pourquoi alors faites-vous un Call TesteSiDossierExiste dans le code Close_file.
EDIT : Ok c'est utilisé pour le bouton depuis le fichier facture

1 = Correct, à la première facture le code créer le sous dossier "2023", etc...

2 = Le fichier facture que vous avez, a été par le fichier FACTURE qui me permet de créer toutes mes factures (Les 2 sont identiques sauf la facture numérotée qui contiendra en plus les données saisies. Je pense que je suis obligé de faire ainsi par rapport à la première facture de l'année qui crée le sous dossier ANNEE.

Lors de la création de ma facture je me suis aperçu que l'année ne se mettait plus en ligne C33 dans le fichier DONNEES, j'ai rectifié le tire et j'ai testé par le bouton ARCHIVER LA DERNIERE FACTURE en lançant directement la macro DeplacerFichier et cela fonctionne. Donc, dans le code Close_File j'ai appelé la macro DeplacerFichier et cela ne fait rien. J'y comprends plus rien

1 = Correct, à la première facture le code créer le sous dossier "2023", etc.

Faites un test avec ce code-ci

Sub TesteSiDossierExiste()
'Cette macro permet de tester si un dossier existe et de le créer s'il n'existe pas
Dim Chemin As String 'Chemin du dossier
Dim DossierCellule As String 'Chemin parent du dossier
Dim NomDossier As String 'Nom du dossier

DossierCellule = "C:\FACTURE\ARCHIVES FACTURES\" 'Chemin du dossier parent
NomDossier = Year(Now()) 'Année 'Nom du dossier
Chemin = DossierCellule & NomDossier & "\" 'Combiner le chemin du dossier parent et le nom du dossier

If Dossier(Chemin) = False Then 'Si le dossier n'existe pas
    If MsgBox("   Le dossier pour sauvegarder les FACTURES EN COURS n'existe pas..." & Chr(10) & Chr(10) & "   Souhaitez-vous le créer ?", 4 + 64, "Création du dossier...") = vbYes Then 'Demander si le dossier doit être créé
        MkDir (Chemin) 'Créer le dossier
        MsgBox "   Votre dossier a été créé, CLIQUEZ sur le bouton [OK) pour archiver la facture !!!", 0 + 64, "Aux Cochons d'Ausson ..." 'Message de fin
    Else: Exit Sub
    End If
End If

Call DeplacerFichier 'Appeler la macro DeplacerFichier
End Sub

2 = Le fichier facture que vous avez...

En voyant votre fichier Facture, je me demande pourquoi vous n'avez pas fait un seul fichier. C'eut été nettement plus simple

3. Dans votre fichier donnees, macro dans thisworkbook, pensez à ajouter un On Error resume next juste avant Application.width..... Cela évite un bug si l'écran du PC ne permet pas d'afficher aux dimensions que vous demandez

Non rien à faire ... Il veut rien entendre

Mais en cliquant sur mon bouton programmer sur DeplacerFichier, le fichier est déplacé.

Non rien à faire ... Il veut rien entendre

Vous parlez de quoi là ? si c'est du code placé dans mon point 1, que voulez-vous dire ?

Répondez point par point sans quoi on ne va pas en sortir