Beug avec ActiveWorkbook.Save dans un module

**goninph** · 25/09/2019, 14h02

Bonjour,

Cette macro est lancée avec Private Sub Workbook_BeforeSave et fonctionne parfaitement bien avec le raccourcis clavier CTRL+S et avec le clic sur la disquette Enregistrer de la barre d'outils Excel.

Cependant impossible de la lancer la macro via ActiveWorkbook.Save, la feuille Interventions ne se copie pas.

J'ai essayé de déplacer ActiveWorkbook.Save dans une feuille, puis une autre feuille, dans ThisWorkbook, mais rien ne change.

C'est comme si la macro ne reconnaissait pas le classeur et ne trouvait pas les feuilles, car si la feuille planning existe elle n'est pas supprimée au départ de la macro …

C'est étrange, quelqu'un a t'il déjà rencontré ce problème ?

Merci pour votre aide
Philippe

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
Sub Bouton_Save()
    ActiveWorkbook.Save
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
Option Explicit
Dim chemin As String
Dim Nom_du_xlsx As String
Sub Copie_fichier_xlsx() 'Dans Workbook_BeforeSave
Dim Verification As Boolean
Dim MonClasseur As String
    chemin = ThisWorkbook.Path & "\"
    Nom_du_xlsx = "Copie du planning.xlsx"
'Mise à jour de la copie avec la Function EstClasseurOuvert(MonClasseur As String)
    MonClasseur = chemin & Nom_du_xlsx
        'Vérifier si la copie existe
            If Len(Dir(MonClasseur)) = 0 Then
                'Si la copie n'existe pas, créer la copie
                Copie_xlsx.Creation_Fichier_Planning_xlsx
             Else
        'Si la copie existe, vérifier si la copie est ouverte
            Verification = EstClasseurOuvert(MonClasseur)
            If Verification = True Then
                'Si la copie est ouverte on informe et on quitte.
                MsgBox "La copie du planning est ouverte, mise à jour impossible...", vbInformation, "Info"
                Exit Sub
            Else
                'Si la copie est fermée
                Copie_xlsx.Creation_Fichier_Planning_xlsx
            End If
    End If
End Sub
Function EstClasseurOuvert(MonClasseur As String)
'Pour vérifier si un classeur est ouvert
Dim NumeroFichier As Long, NumeroErreur As Long
 
    On Error Resume Next
    NumeroFichier = FreeFile()
    Open MonClasseur For Input Lock Read As #NumeroFichier
    Close NumeroFichier
    NumeroErreur = Err
    On Error GoTo 0
 
    Select Case NumeroErreur
    Case 0:    EstClasseurOuvert = False
    Case 70:   EstClasseurOuvert = True
    Case Else: Error NumeroErreur
    End Select
End Function
Sub Creation_Fichier_Planning_xlsx() 'IMPORTANT !!! Lancer cette macro avec la macro "Copie_fichier_xlsx" pour vérifier avant si la copie est ouverte ou existe
Dim objWorkbookCible As Workbook
Dim objworkbooksource As Workbook
Dim ShProvisoire As Worksheet
Application.ScreenUpdating = False ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
    Set objworkbooksource = ActiveWorkbook
'Suppression de l'onglet "Planning"
    For Each ShProvisoire In Sheets
        If ShProvisoire.Name = "Planning" Then
            Application.DisplayAlerts = False   'Désactive la Msgbox Etes-vous sûr de vouloir supprimer l'onglet
                ShProvisoire.Delete
            Application.DisplayAlerts = True    'Réactive la Msgbox Etes-vous sûr de vouloir supprimer l'onglet
           Exit For
        End If
    Next ShProvisoire
'Copier la feuille
    Sheets("Interventions").Copy After:=Sheets(Sheets.Count)
'Renommer la feuille
    Set ShProvisoire = ActiveSheet
        ShProvisoire.Name = "Planning"
''Supprimer toutes les images de la feuille planning
'        ActiveSheet.DrawingObjects.Delete
'Copier les feuilles
           Sheets(Array("Planning", "DATA_Jours_Fériés")).Copy 'Copier DATA_Jours_Fériés pour colorer le planning
        Set objWorkbookCible = ActiveWorkbook
'Supprimer toutes les images de la feuille DATA_Jours_Fériés
        ActiveSheet.DrawingObjects.Delete
'Enregister le fichier
        Sheets("Planning").Select
            Application.DisplayAlerts = False   'Désactive la Msgbox Etes-vous sûr de vouloir
                ActiveWorkbook.SaveAs chemin & Nom_du_xlsx, FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True    'Réactive la Msgbox Etes-vous sûr de vouloir
                ActiveWorkbook.Close
      Set ShProvisoire = Nothing 'Cette commande sert à libérer l'espace mémoire réservée pour cette variable.
'Supprimer la feuille planning
            Application.DisplayAlerts = False
                Sheets("Planning").Delete
            Application.DisplayAlerts = True
    Sheets("Interventions").Select
Application.ScreenUpdating = True ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
End Sub

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim CheminSource As String
Dim DossierBackup As String
Dim Nom As String
Dim NomMajuscule As String
'Créer une copie du fichier pour lecture
    Copie_xlsx.Copie_fichier_xlsx
'Sauvegarde une copie du fichier nommé: Date & la date, dans un dossier, dans le même dossier du fichier, nommé: Backup & le nom du fichier
    Nom = Environ("USERNAME")
    NomMajuscule = UCase(Nom) 'UCase = Mise en majuscule - LCase = minuscule - Application.proper = Nom propre
    DossierBackup = "Backup " & Left(ThisWorkbook.Name, Len(ThisWorkbook.Name) - 5) 'Pour enlever le .xlsm les 5 caractères depuis la droite
    CheminSource = ThisWorkbook.Path & "\" & DossierBackup & "\"
'Test si le dossier existe déjà
    On Error Resume Next 'N'éxécute pas la ligne qui suit en cas d'erreur
        MkDir CheminSource
    On Error GoTo 0 'Ressort de l'erreur qui permet de nouvelles erreurs
'Sauvegarde d'une copie du fichier avec la date
        ActiveWorkbook.SaveCopyAs CheminSource & Format(Now(), "YYYY.MM.DD hh-mm-ss ") & NomMajuscule & " " & ThisWorkbook.Name
End Sub

**Patrice740** · 25/09/2019, 18h02

Bonjour,

.Select est une méthode très très rarement indispensable, il faut l'éviter.
L'utilisation des objets actifs est souvent une source d'erreur !
Plutôt que ActiveWorkbook et ActiveSheet désignes clairement l'objet concerné.

**goninph** · 26/09/2019, 20h42

Edit :
Le texte en italique n'est pas correct, car si le classeur "Copie du planning.xlsx" est ouvert le classeur "Chevalley.xlsm" n'est pas enregistré.

Pierre,
Je tiens à te remercier pour toutes les infos transmises et surtout le temps passé et la patience à aider un inconnu. Mille merci.
Ce forum est génial et la qualité des infos au top

Au début de cette discussion je pensais vite ajouter un bouton sur la feuillle pour effectuer excatement toutes les macros contenues dans Workbook_BeforeSave

Merci
Philippe

Pierre,

Lorsque le classeur "Copie du planning.xlsx" est ouvert la macro plante et c'est normal.
Avec mon ancien code, je commençais par vérifier avec la Sub Copie_fichier_xlsx() si le classeur "Copie du planning.xlsx" existe, si il n'existe pas, on le créer, puis si il est ouvert on informe que la copie du planning est ouverte et que la mise à jour du classeur "Copie du planning.xlsx" est impossible.

J'ai affecté cette macro au bouton se trouvant sur la feuille Intervention du classeur "Chevalley.xlsm" et tout se passe correctement lorsque le Classeur n'existe pas ou qu'il est ouvert.

En revanche avec Workbook_BeforeSave on lance la macro via CreateCopy et là forcement ça plante lorsque le classeur "Copie du planning.xlsx" est ouvert.

Y a-t-il une autre manière de vérifier si le classeur "Copie du planning.xlsx" est ouvert ?

Merci

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
Option Compare Text 'Pour évietre les problème de minus ou majuscule dans les noms des variantes "AAA" is equal to "aaa".
Option Explicit
Dim chemin As String
Dim Nom_du_xlsx As String
Sub Copie_fichier_xlsx() 'Dans Workbook_BeforeSave
Dim Verification As Boolean
Dim MonClasseur As String
    chemin = ThisWorkbook.Path & "\"
    Nom_du_xlsx = "Copie du planning.xlsx"
'Mise à jour de la copie avec la Function EstClasseurOuvert(MonClasseur As String)
    MonClasseur = chemin & Nom_du_xlsx
        'Vérifier si la copie existe
            If Len(Dir(MonClasseur)) = 0 Then
                'Si la copie n'existe pas, créer la copie
                Copie_xlsx.CreateCopy
             Else
        'Si la copie existe, vérifier si la copie est ouverte
            Verification = EstClasseurOuvert(MonClasseur)
            If Verification = True Then
                'Si la copie est ouverte on informe et on quitte.
                MsgBox "La copie du planning est ouverte, mise à jour impossible...", vbInformation, "Info"
                Exit Sub
            Else
            'Si la copie est fermée
                Copie_xlsx.CreateCopy
            End If
    End If
End Sub
Sub CreateCopy(Optional CalledBySave As Boolean)
Dim Target As Workbook
On Error GoTo Catch
Application.ScreenUpdating = False
'Copier les feuilles
    Sheets(Array("Interventions", "DATA_Jours_Fériés")).Copy
    Set Target = ActiveWorkbook
'Renommer la feuille
    ThisWorkbook.Activate
    Target.Worksheets("Interventions").Name = "Planning"
'Actions sur le nouveau classeur
    With Target.Worksheets("Planning")
        .Range("S1") = Now & " dernière mise à jour de cette copie du planning."         'Indiquer la date de mise à jour dans le planning
        .DrawingObjects.Delete 'Supprimer toutes les images
    End With
    Target.Worksheets("DATA_Jours_Fériés").DrawingObjects.Delete  'Supprimer toutes les images
'Enregister le fichier
    Application.DisplayAlerts = False
    Target.SaveAs Filename:=chemin & Nom_du_xlsx, FileFormat:=xlOpenXMLWorkbook 'FileFormat:=XlFileFormat.xlOpenXMLWorkbookMacroEnabled
    Target.Close False
    Application.DisplayAlerts = True
    If Not CalledBySave Then ThisWorkbook.Save
Catch:
'  If Err <> 0 Then MsgBox "L'erreur suivante est survenue:" & vbLf & Err.Description, vbExclamation, "Erreur " & Err.Number
Application.ScreenUpdating = True
End Sub

**Zekraoui_Jakani** · 25/09/2019, 18h06

Je n'ai pas tout analysé, mais la ligne 52 me paraît suspecte:

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each ShProvisoire In Sheets

Je la remplacerai par :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

For Each ShProvisoire In ActiveWorkbook.Sheets

**Pierre Fauconnier** · 25/09/2019, 18h55

Salut.

A la ligne 48 du code que tu proposes, tu as Dim ShProvisoire As Worksheet et à la ligne 52, tu as For Each ShProvisoire In Sheets.

Si tu as une feuille de graphique dans ton classeur, ça va poser problème car tu vas essayer d'attribuer à un objet Worksheet un truc qui n'est pas un worksheet.

As-tu un message d'erreur, une ligne qui plante?

**goninph** · 25/09/2019, 19h25

Edit:

J'ai corrigé selon info de Zekraoui_Jakani, mais statuquo

Bonsoir,

Alors je n'ai aucun graphique et je tiens à préciser que tout fonctionne parfaitement bien avec le raccourcis clavier CTRL+S et avec le clic sur la disquette Enregistrer de la barre d'outils Excel.

As-tu un message d'erreur, une ligne qui plante ?
Oui j'ai un message d'erreur, lorsque la macro veut copier dans un nouveau classeur la feuille planning qui n’existe pas.

Mais le problème survient tout au début :
En fait tout au début la macro doit supprimer la feuille planning si par hasard il en existe une, s’il en existe une elle reste, le problème survient uniquement avec ActiveWorkbook.Save pour lancer la macro, avec le raccourcis clavier CTRL+S et elle est supprimée.
Ensuite elle doit copier ma feuille Interventions, et bien rien ne se passe, c'est comme si la macro était aveugle et ne trouvait pas les feuilles, mais uniquement avec ActiveWorkbook.Save pour lancer la macro, avec le raccourcis clavier CTRL+S la feuille est copiée.

A devenir fou

Merci pour le coup de main A+

**Patrice740** · 25/09/2019, 19h42

Re,

Envoyé par Pierre Fauconnier

As-tu un message d'erreur, une ligne qui plante?

Envoyé par goninph

Oui j'ai un message d'erreur, lorsque la macro veut copier dans un nouveau classeur la feuille planning qui n’existe pas.

Et pourrais tu nous dire quel message et sur quelle ligne ?
(Évites de répondre « Oui, je le peux »)

**Pierre Fauconnier** · 25/09/2019, 20h00

Envoyé par Patrice740

[...]
L'utilisation des objets actifs est souvent une source d'erreur !
Plutôt que ActiveWorkbook et ActiveSheet désignes clairement l'objet concerné.

Envoyé par goninph

[...]En fait tout au début la macro doit supprimer la feuille planning si par hasard il en existe une[...]

Peut-être la feuille Planning n'est-elle pas dans le classeur actif?

Dans une autre discussion, je t'ai clairement expliqué de découper ton code en petites procédures/fonctions faciles à gérer. Ici, Patrice te parle d'objets actifs qui posent souvent problème. Peut-être pourrais-tu lancer ton code en pas-à-pas (mettre éventuellement un point d'arrêt au début de la proc si elle est événementielle) pour voir quel classeur est considéré par le code au moment de la tentative de suppression.

Dans ta fonction Sub Creation_Fichier_Planning_xlsx(), tu as la ligne Set objworkbooksource = ActiveWorkbook puis plus loin Set objWorkbookCible = ActiveWorkbook. Ces lignes ne servent à rien puisque tu n'utilises pas les objets objworkbooksource et objWorkbookCible dans le code, par exemple pour préfixer tes feuilles.

Je pense donc, probablement comme Patrice, qu'il y a un beau micmac dans ton code entre classeur actif et classeur qui contient la macro... Je pense que tu devrais d'abord exprimer en français (sans jargon Excel ou VBA) ce que tu souhaites réaliser en étapes courtes et concises, puis coder ces étapes courtes dans des procédures/fontion (une par étape). Après quoi, tu pourras les assembler dans un code procédural qui tient la route.

**goninph** · 25/09/2019, 20h36

Nom : 2019-09-25_20-34-08.png
Affichages : 1108
Taille : 9,3 Ko

**Pierre Fauconnier** · 25/09/2019, 20h40

Ca, on s'en doutait un peu.

Ce que tu dois faire, c'est regarder quel est ton classeur actif à ce moment-là. Car c'est très probablement là que le bât blesse.

Comme le dit Patrice, travailler sur le classeur actif n'est pas forcément sécurisant, et je t'ai dit que tu avais des problèmes avec les objets qui pointent vers ActiveWorkbook puisque tu ne les utilises pas dans ton code.

**goninph** · 25/09/2019, 20h50

Pierre Fauconnier, effectivement, j'avais repris ce code dans un ancien fichier ...

J'ai enlever le superflus, mais toujours le même problème.

Je me pose la question pourquoi tout fonctionne nickel avec avec le raccourcis clavier CTRL+S et que ça plante avec ActiveWorkbook.Save

Y a t'il une autre solution pour lancer l'enregistrement du fichier, via une macro ?

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
Sub Creation_Fichier_Planning_xlsx() 'IMPORTANT !!! Lancer cette macro avec la macro "Copie_fichier_xlsx" pour vérifier avant si la copie est ouverte ou existe
'Les autres varaibles sont dans Sub Copie_fichier_xlsx()
Dim ShProvisoire As Worksheet
Application.ScreenUpdating = False ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
'Suppression de l'onglet "Planning"
    For Each ShProvisoire In ThisWorkbook.Sheets
        If ShProvisoire.Name = "Planning" Then
            Application.DisplayAlerts = False   'Désactive la Msgbox Etes-vous sûr de vouloir supprimer l'onglet
                ShProvisoire.Delete
            Application.DisplayAlerts = True    'Réactive la Msgbox Etes-vous sûr de vouloir supprimer l'onglet
           Exit For
        End If
    Next ShProvisoire
'Copier la feuille
    Sheets("Interventions").Copy After:=Sheets(Sheets.Count)
'Renommer la feuille
    Set ShProvisoire = ActiveSheet
        ShProvisoire.Name = "Planning"
'Supprimer toutes les images de la feuille planning
        ActiveSheet.DrawingObjects.Delete
'Indiquer la date de mise à jour dans le planning
        Range("S1") = Now & " dernière mise à jour de cette copie du planning."
'Copier les feuilles
           Sheets(Array("Planning", "DATA_Jours_Fériés")).Copy 'Copier DATA_Jours_Fériés pour colorer le planning
'Supprimer toutes les images de la feuille DATA_Jours_Fériés
        ActiveSheet.DrawingObjects.Delete
'Enregister le fichier
        Sheets("Planning").Select
            Application.DisplayAlerts = False   'Désactive la Msgbox Etes-vous sûr de vouloir
                ActiveWorkbook.SaveAs chemin & Nom_du_xlsx, FileFormat:=xlOpenXMLWorkbook
            Application.DisplayAlerts = True    'Réactive la Msgbox Etes-vous sûr de vouloir
                ActiveWorkbook.Close
      Set ShProvisoire = Nothing 'Cette commande sert à libérer l'espace mémoire réservée pour cette variable.
'Supprimer la feuille planning
            Application.DisplayAlerts = False
                Sheets("Planning").Delete
            Application.DisplayAlerts = True
    Sheets("Interventions").Select
Application.ScreenUpdating = True ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
End Sub

**Pierre Fauconnier** · 26/09/2019, 06h50

Envoyé par goninph

[...]et que ça plante avec ActiveWorkbook.Save[...]

Ca ne plante pas avec ActiveWorkbook.Save. Dans un précédent message, tu as illustré que ça plantait avec Sheets(Array("Planning", "DATA_Jours_Fériés")).Copy (L'indice n'appartient pas à la sélection). Cette erreur signifie que, au moment de l'exécution de cette ligne-là, le classeur actif n'est pas le bon et ne possède pas au moins une des deux feuilles renseignées. Lorsque le code plante sur cette ligne-là, va dans la fenêtre d'exécution (CTRL+G) et saisis ? activeworkbook.name puis ENTER et regarde le nom qui s'affiche.

Comme le dit Patrice, ta macro, parce qu'elle utilise l'objet actif, fonctionnera forcément différemment selon le classeur actif à ce moment-là. Si ça ne plante pas avec F5 ou F8, c'est que c'est le bon classeur qui est actif à ce moment-là. Lorsque ça plante, c'est probablement parce que la macro est démarrée d'un bouton ou d'un événement dans l'environnement Excel et qu'à ce moment-là, la macro démarre du mauvais classeur.

Tu devrais donc travailler avec des objets qui pointe vers tes classeurs, et je t'ai déjà dit dans un précédent message que ces variables existent, mais que dans ton code, tu ne les utilisent pas.

**Transitoire** · 26/09/2019, 07h50

Bonjour, dans le post#5 la phrase ci-dessous me semble étrange, n'est-il pas?

En fait tout au début la macro doit supprimer la feuille planning si par hasard il en existe une, s’il en existe une elle reste

Cordialement

**goninph** · 26/09/2019, 08h00

Correction :
En fait tout au début la macro doit supprimer la feuille planning si par hasard il en existe une.
Si la feuille planning existe, elle n'est pas supprimée avec ActiveWorkbook.Save ...
Pas bourré, fatigué

Envoyé par Transitoire

Bonjour, dans le post#5 la phrase ci-dessous me semble étrange, n'est-il pas?

Cordialement

**goninph** · 25/09/2019, 20h51

Une autre info, lorsque je lance la macro avec F5 ou F8 tout fonctionne également

**Patrice740** · 26/09/2019, 00h47

Re,

Envoyé par goninph

Je me pose la question pourquoi tout fonctionne nickel avec avec le raccourcis clavier CTRL+S et que ça plante avec ActiveWorkbook.Save

La seule bonne question c'est « pourquoi ça plante avec ActiveWorkbook.Save »
Le pourquoi ça fonctionne est totalement superflu, c'est surement le hasard.
Ce que tu dois en déduire c'est que le fonctionnement est contextuel, et il faut éviter ça.

Tu dois t'appliquer à écrire du code qui fonctionne quel que soit le contexte.
Comme je t'ai déjà dit, dans un code propre on n’utilise pas .Select, ActiveSheet, Activeworkbook, ....
Il y a aussi une instruction que j'évite, pour la même raison, c'est :
Sheets(Array("Planning", "DATA_Jours_Fériés")).Copy sans destination !

**goninph** · 26/09/2019, 08h27

Bonjour Pierre,

dans la fenêtre d'exécution s'affiche : Planning Chevalley.xlsm et c'est correct.

j'ai corrigé la macro, en bien je l'espère, mais toujours impossible de supprimer la feuille planning.

Lors de la recherche de la feuille planning, la macro détecte la feuille planning, car si je déplace la feuille planning en première position, la macro boucle 1x et si je la déplace la position de la feuille planning, le nombre de boucle correspond à la position.

je continue à chercher ...

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
Sub Creation_Fichier_Planning_xlsx() 'IMPORTANT !!! Lancer cette macro avec la macro "Copie_fichier_xlsx" pour vérifier avant si la copie est ouverte ou existe
'Les autres variables sont dans Sub Copie_fichier_xlsx()
Dim Mon_WorkBook As Workbook
Dim New_WorkBook As Workbook
    Set Mon_WorkBook = Workbooks("Planning Chevalley.xlsm")
'Suppression de la feuille "Planning" si elle existe
Application.ScreenUpdating = False ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
    Application.DisplayAlerts = False
    With Mon_WorkBook
        If FeuilleExiste("Planning") Then Sheets("Planning").Delete 'Avec Function FeuilleExiste(Nom As String) As Boolean
    Application.DisplayAlerts = True
    End With

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Function FeuilleExiste(Nom As String) As Boolean
'Pour vérifier si la feuille existe
    Dim sh As Object
    For Each sh In Sheets
        If UCase(sh.Name) = UCase(Nom) Then
            FeuilleExiste = True
            Exit For
        End If
    Next
End Function

**Pierre Fauconnier** · 26/09/2019, 09h13

Ta fonction FeuilleExiste ne travaille qu'avec le classeur actif. Le fait d'intégrer cette fonction dans un bloc with n'y change rien.

Remplace ta fonction par la suivante, qui travaille avec le classeur actif par défaut, mais qui permet de définir le classeur sur les feuilles duquel on va boucler. C'est indispensable lorsque le code manipule plusieurs classeurs. Au passage, tu verras que j'ai supprimé le Exit For (A ne jamais utiliser, ça ne devrait pas exister, ce truc). N'oublie jamais non plus que le code peut différencier les majuscules des minuscules et que c'est ce qu'il fait par défaut (absence de Option Compare en début de module => différenciation de la casse). il est donc prudent, pour une formule générique comme FeuilleExiste, de ne pas dépendre de cette option, et c'est la raison de la transformation en majuscules.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
Function FeuilleExiste(Nom As String, Optional wb As Workbook) As Boolean
  Dim Counter As Long: Counter = 1
 
  If wb Is Nothing Then Set wb = ActiveWorkbook
  Do While Counter <= wb.Sheets.Count And Not FeuilleExiste
    If UCase(wb.Sheets(Counter).Name) = UCase(Nom) Then FeuilleExiste = True
    Counter = Counter + 1
  Loop
End Function

Après, à la ligne 10 du code que tu as fourni, remplace le code par celui-ci (NE PAS OUBLIER le . devant Sheets("Planning"), sinon, tu ne rattaches pas Sheets("Planning") à l'objet Mon_WorkBook stipulé dans le bloc WITH.

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

If FeuilleExiste("Planning", Mon_WorkBook) Then .Sheets("Planning").Delete

Je n'ai pas regardé le reste du code, et je suspecte que des erreurs du type . manquant soient encore présentes. Tu dois être rigoureux dans ton code et comprendre ce que tu écris. Dans une autre discussion, je t'ai renseigné un tuto complet sur le VBA. Il est plus que temps que tu t'y plonges avec des exemples simples pour bien appréhender le langage.

**goninph** · 26/09/2019, 10h38

Pierre,

Code de la macro et de la Fonction corrigé, mais toujours le problème, pour tester, j'ai essayer de remplacer .delete par .select mais la feuille ne se sélectionne pas ... avec CTRL+S ça fonctionne toujours

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
Sub Creation_Fichier_Planning_xlsx() 'IMPORTANT !!! Lancer cette macro avec la macro "Copie_fichier_xlsx" pour vérifier avant si la copie est ouverte ou existe
'Les autres variables sont dans Sub Copie_fichier_xlsx()
Dim Mon_WorkBook As Workbook
Dim New_WorkBook As Workbook
    Set Mon_WorkBook = Workbooks("Planning Chevalley.xlsm")
'Suppression de la feuille "Planning" si elle existe
Application.ScreenUpdating = False ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
        Application.DisplayAlerts = False
            If FeuilleExiste("Planning", Mon_WorkBook) Then Mon_WorkBook.Sheets("Planning").Delete 'Avec Function FeuilleExiste(Nom As String) As Boolean
        Application.DisplayAlerts = True

**goninph** · 26/09/2019, 11h53

Question : est-ce que ça fonctionne sur votre PC, car j'ai créé un nouveau Classeur avec la macro directement Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
et j'ai toujours le même problème avec CTRL+S la feuille planning est supprimée, mais avec ActiveWorkbook.Save la feuille Planning n'est pas supprimée.
Le classeur est en copie avec la Feuill1 vierge et la feuille Planning vierge
Module1 avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
Option Explicit
Sub Bouton_Save_Click()
    ActiveWorkbook.Save
End Sub

et ThisWorkbook avec :

Code :

Sélectionner tout - Visualiser dans une fenêtre à part

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Option Explicit
Function FeuilleExiste(Nom As String, Optional wb As Workbook) As Boolean
'Pour vérifier si la feuille existe
  Dim Counter As Long: Counter = 1
 
  If wb Is Nothing Then Set wb = ActiveWorkbook
  Do While Counter <= wb.Sheets.Count And Not FeuilleExiste
    If UCase(wb.Sheets(Counter).Name) = UCase(Nom) Then FeuilleExiste = True
    Counter = Counter + 1
  Loop
End Function
Private Sub Workbook_BeforeSave(ByVal SaveAsUI As Boolean, Cancel As Boolean)
Dim Mon_WorkBook As Workbook
'Suppression de la feuille "Planning" si elle existe
Set Mon_WorkBook = Workbooks("Test Save.xlsm")
Application.ScreenUpdating = False ' Résactive le changement des pages à l'écran lors de l'éxécution de la macro
        Application.DisplayAlerts = False
            If FeuilleExiste("Planning", Mon_WorkBook) Then Mon_WorkBook.Sheets("Planning").Delete 'Avec Function FeuilleExiste(Nom As String) As Boolean
        Application.DisplayAlerts = True
End Sub

Test Save.xlsm

Beug avec ActiveWorkbook.Save dans un module

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager