Microsoft 365 Exécutions directes différentes vs "pas à pas"

Quentin2106

XLDnaute Nouveau
Bonjour à toutes et tous,

Je rencontre actuellement un problème sur une de mes macros, pour laquelle l'exécution classique/automatique diffère de l'exécution pas à pas.

Ci-dessous mon code, dans les grandes lignes :
1) J'ai mon fichier maître dans un dossier, et je veux traiter tous les fichiers présents dans ce même dossier (en dehors de mon fichier maître).
2) Je déclare mes variables, demande des infos via Msgbox, crée un dossier d'arrivée .... => entre le partie 1 et 5, RAS
3) Sur la partie 6, dans la boucle, le code ne répond pas à mon besoin.
Ce que je veux faire = si certaines conditions sont remplies, j'ouvre un fichier, je colle une page de garde, puis je sauvegarde/ferme et déplace ce fichier tout en supprimant celui d'origine.
Sinon, je ne le sauvegarde pas et je supprime complétement ce fichier d'origine (sans l'avoir déplacé auparavant).

Lors de l'exécution auto, quand la partie "If Sheets("PROGRAMMES").Range("A7") <> "" Then" ne se vérifie pas, la ligne de code "wrk_Nouveau.SaveAs CheminCréa & "\" & wrk_Nouveau.Name" s'exécute tout de même (ou du moins, le programme se déplace ), alors que je veux que le fichier d'origine se supprime sans être déplacé.

En "pas à pas", tout fonctionne comme prévu.

=> Quelqu'un aurait-il une idée d'explication ?

Démarrant en VBA, je suis globalement preneur d'informations plus globales pour améliorer mon code.
Et je reste bien évidemment à dispo s'il manque des infos pour comprendre le problème.

Merci !!
Quentin


VB:
Sub PageDeGarde()

Application.ScreenUpdating = False

'1. Déclaration des variables et des chemins d'accès

    Dim wrk_Matrice As Workbook
    Set wrk_Matrice = ThisWorkbook
   
    Dim wrk_Nouveau As Workbook
   
    Dim Fich As String
    Dim Chemin As String
    Chemin = Sheets("MACRO").Range("C17").Value & "\"
    Fich = Dir(Chemin & "*.xlsx")
         
    Dim CheminCréa As String
         
    Dim strg_Exception As String
    strg_Exception = ActiveWorkbook.Name
       
       
'2. Msgbox demandant le n° de version Staging + renseigner la valeur dans l'onglet "RESUME"
   
    Dim strg_Question1 As String
    strg_Question1 = InputBox("Quelle est le n° de semaine traitée ?", "Semaine : ")
       
       
'3. Msgbox demandant le n° de version Prod + renseigner la valeur dans l'onglet "RESUME"
       
    Dim strg_Question2 As String
    strg_Question2 = InputBox("Quelle est l'année traitée ?", "Année : ")


'4. Numéro de semaine dans la page de garde
   
    Sheets("PAGE DE GARDE").Range("F4").Value = "Résultats de la semaine " & strg_Question1 & "/" & strg_Question2


'5. Création du dossier "Semaine xx"

    CheminCréa = Sheets("MACRO").Range("C18").Value & strg_Question2 & "\Preview\Semaine " & strg_Question1
    MkDir (CheminCréa)


'6. Boucle pour ajout de la page de garde dans tous les fichiers

    Do While Fich <> ""
    'Tant qu'il y a des fichiers dans le dossier
       
        If Fich = strg_Exception Then
        'Si le fichier est pas la matrice actuellement ouverte, on ne fait rien
               
            Fich = Dir()
             
        Else
               
                Workbooks.Open (Chemin & Fich)
                Set wrk_Nouveau = ActiveWorkbook
                       
                wrk_Matrice.Activate
                Sheets("PAGE DE GARDE").Select
                Sheets("PAGE DE GARDE").Copy Before:=wrk_Nouveau. _
                Sheets(1)
                'Copier la page de garder et la coller dans le doc client
           
                'Si le fichier ne comprend pas de données, on le ferme. Sinon on le déplace.
                If Sheets("PROGRAMMES").Range("A7") <> "" Then
               
                    wrk_Nouveau.SaveAs CheminCréa & "\" & wrk_Nouveau.Name
                    wrk_Nouveau.Close
                   
                Else
               
                    MsgBox ("Le fichier " & ActiveWorkbook.Name & " est vide")
                    wrk_Nouveau.Close Savechanges:=False
     
                End If
       
                'On supprime les fichiers de leurs précédents emplacements
                Kill Chemin & Fich
                Fich = Dir()

        End If
       
    Loop


'7. Msgbox pour annoncer la fin de la macro
   
    wrk_Matrice.Activate
    Sheets("MACRO").Activate
    Range("A1").Select
    MsgBox ("Page de garde ajoutée à tous les fichiers" & Chr(13) & Chr(10) & "Les fichiers ont été déplacés dans le dossier Semaine " & strg_Question1)
 
 
Application.ScreenUpdating = True
   
End Sub
 
Solution
C
Bonjour Quentin2106 et bienvenue sur ce forum

Pour moi, le problème vient du fait que vous n'utilisez pas les objets conteneurs comme il faut

Essayez donc avec ce code en lancement complet (attention j'ai peut-être commis des erreurs)
VB:
Sub PageDeGarde()
  Application.ScreenUpdating = False
  '1. Déclaration des variables et des chemins d'accès
  Dim wrk_Matrice As Workbook
  Dim Wrk_Nouveau As Workbook
  Dim Fich As String
  Dim Chemin As String
  Dim CheminCréa As String
  Dim strg_Exception As String
   
  Set wrk_Matrice = ThisWorkbook
  '2. Msgbox demandant le n° de version Staging + renseigner la valeur dans l'onglet "RESUME"
  Dim strg_Question1 As String
  strg_Question1 = InputBox("Quelle est le n° de semaine traitée ?"...
C

Compte Supprimé 979

Guest
Bonjour Quentin2106 et bienvenue sur ce forum

Pour moi, le problème vient du fait que vous n'utilisez pas les objets conteneurs comme il faut

Essayez donc avec ce code en lancement complet (attention j'ai peut-être commis des erreurs)
VB:
Sub PageDeGarde()
  Application.ScreenUpdating = False
  '1. Déclaration des variables et des chemins d'accès
  Dim wrk_Matrice As Workbook
  Dim Wrk_Nouveau As Workbook
  Dim Fich As String
  Dim Chemin As String
  Dim CheminCréa As String
  Dim strg_Exception As String
   
  Set wrk_Matrice = ThisWorkbook
  '2. Msgbox demandant le n° de version Staging + renseigner la valeur dans l'onglet "RESUME"
  Dim strg_Question1 As String
  strg_Question1 = InputBox("Quelle est le n° de semaine traitée ?", "Semaine : ")
  '3. Msgbox demandant le n° de version Prod + renseigner la valeur dans l'onglet "RESUME"
  Dim strg_Question2 As String
  strg_Question2 = InputBox("Quelle est l'année traitée ?", "Année : ")
  '4. Numéro de semaine dans la page de garde
  wrk_Matrice.Sheets("PAGE DE GARDE").Range("F4").Value = "Résultats de la semaine " & strg_Question1 & "/" & strg_Question2
  '5. Création du dossier "Semaine xx"
  CheminCréa = wrk_Matrice.Sheets("MACRO").Range("C18").Value & strg_Question2 & "\Preview\Semaine " & strg_Question1
  MkDir (CheminCréa)
  '6. Boucle pour ajout de la page de garde dans tous les fichiers
  Chemin = wrk_Matrice.Sheets("MACRO").Range("C17").Value & "\"
  Fich = Dir(Chemin & "*.xlsx")
  strg_Exception = wrk_Matrice.Name
  ' Parcourir les fichiers
  Do While Fich <> ""
    'Tant qu'il y a des fichiers dans le dossier
    If Fich = strg_Exception Then
      'Si le fichier est pas la matrice actuellement ouverte, fichier suivant
      Fich = Dir()
    Else
      Set Wrk_Nouveau = Workbooks.Open(Chemin & Fich)
      'Copier la page de garder et la coller dans le doc client
      wrk_Matrice.Sheets("PAGE DE GARDE").Copy Before:=Wrk_Nouveau.Sheets(1)
      'Si le fichier ne comprend pas de données, on le ferme. Sinon on le déplace.
      If Wrk_Nouveau.Sheets("PROGRAMMES").Range("A7") <> "" Then
          Wrk_Nouveau.SaveAs CheminCréa & "\" & Wrk_Nouveau.Name
          Wrk_Nouveau.Close
      Else
          MsgBox ("Le fichier " & Wrk_Nouveau.Name & " est vide")
          Wrk_Nouveau.Close Savechanges:=False
      End If
      'On supprime les fichiers de leurs précédents emplacements
      Kill Chemin & Fich
      Fich = Dir()
    End If
  Loop
  '7. Msgbox pour annoncer la fin de la macro
  wrk_Matrice.Activate
  Sheets("MACRO").Activate
  Range("A1").Select
  MsgBox ("Page de garde ajoutée à tous les fichiers" & Chr(13) & Chr(10) & "Les fichiers ont été déplacés dans le dossier Semaine " & strg_Question1)
  Application.ScreenUpdating = True
End Sub

A+
 

Statistiques des forums

Discussions
314 716
Messages
2 112 163
Membres
111 447
dernier inscrit
jasontantane