Modification-Suppression : Cette action ne peut être réalisée car le dossier est ouvert dans un autre program

**Thallhos** · 17/09/2017, 12h08

Bien le bonjour au forum,

Je viens vers vous à la suite d'une erreur récurrente mais dont je n'arrive pas à comprendre la logique :

1) J'utilise ma macro pour créer un dossier sur mon bureau contenant un fichier excel et un doc PDF,
2) Puis copier coller des infos provenant de mon fichier Excel de départ dans le nouveau fichier excel fraîchement créé.

Ci dessous mon code :

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
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
Sub Save_PDF()
Dim XLBook As Workbook
 
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
 
On Error GoTo Err1
A = Sheets(Feuil3.Name).Range("B1").Value
MkDir (Environ("userprofile") & "\Desktop\Audit Follow-up")
 
 
On Error Resume Next
'On sélectionne les feuilles qui nous intéressent à enregistrer en PDF"
ActiveWorkbook.Sheets(Array(Feuil1.Name, Feuil11.Name, Feuil12.Name, Feuil2.Name, Feuil3.Name, Feuil10.Name)).Select
 
'On choisit d'enregistrer sur le bureau quel que soit l'ordinateur utilisé
ChDir Environ("userprofile") & "\Desktop\Audit Follow-up"
 
'On active les feuilles afin de prendre en compte leurs contenus, puis on renomme le fichier final
ActiveSheet.ExportAsFixedFormat Type:=xlTypePDF, _
Filename:="Audit Follow-up", _
Quality:=xlQualityStandard, _
IncludeDocProperties:=True, _
IgnorePrintAreas:=False, _
OpenAfterPublish:=False
 
Feuil8.Select
Application.DisplayAlerts = False
'On crée sur le bureau un nouveau fichier Excel
Workbooks.Add.SaveAs "Suivi Audits Externes.xlsx"
'On ouvre le nouveau fichier Excel créé
Workbooks.Open ("Suivi Audits Externes.xlsx")
Sheets.Add.Name = "Revue Analytique mensuelle"
Sheets.Add.Name = "Détails Audits externes"
Sheets.Add.Name = "Suivi Audits externes"
 
 
Dim Compteur As Integer, Nom As String
    Application.DisplayAlerts = False
    For Compteur = Worksheets.Count To 1 Step -1
        Nom = Sheets(Compteur).Name
        Select Case Nom
        Case "Suivi Audits externes", "Détails Audits externes", "Revue Analytique mensuelle"
 
        Case Else
            Sheets(Compteur).Delete
        End Select
    Next Compteur
    Application.DisplayAlerts = True
 
'On copie colle les informations dans ce nouveau fichier Excel
'Suivi des audits externes
ThisWorkbook.Sheets(Feuil2.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Suivi Audits externes").Activate
            Cells.Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Cells.Copy
            Cells.PasteSpecial xlValues
            Range("A1").Select
'Détails des audits externes
ThisWorkbook.Sheets(Feuil3.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Détails Audits externes").Activate
            Range("A1").Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Range("A1").Select
 
'Revue analytique mensuelle
ThisWorkbook.Sheets(Feuil10.Name).Activate
            Cells.Copy
Workbooks("Suivi Audits Externes.xlsx").Activate
            ActiveWorkbook.Sheets("Revue Analytique mensuelle").Activate
            Range("A1").Select
            With Selection
            .PasteSpecial xlPasteAll
            End With
            Application.CutCopyMode = False
            Range("A1").Select
 
ActiveWorkbook.Sheets("Suivi Audits externes").Activate
 
'Dim i As Long
'Dim Lien As Variant
 
    'Lien = ActiveWorkbook.LinkSources(Type:=xlLinkTypeExcelLinks)
    'For i = LBound(Lien) To UBound(Lien)
        'ActiveWorkbook.BreakLink Name:=Lien(i), Type:=xlLinkTypeExcelLinks
    'Next i
 
With ActiveWorkbook
    .Save
    .Close
End With
 
Application.DisplayAlerts = True
On Error GoTo 0
ThisWorkbook.Sheets(Feuil1.Name).Activate
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Exit Sub
Err1:
MsgBox "Un dossier portant ce nom existe déjà, veuillez le supprimer, puis relancer la macro"
On Error GoTo 0
End Sub

Juste avant d'entamer les copier/coller je peux supprimer/renommer mon dossier sans problème, c'est uniquement après avoir copier/coller que cela ne fonctionne plus.

J'ai pensé que cela provenait des formules qui conservaient les liens avec le dossier original mais même avec après avoir essayé de rompre les liens entre les deux classeurs, ca ne fonctionne toujours pas.

Après avoir essayé différent scénario le seul qui me permet de rename/delete c'est de fermer Excel et TOUS les classeurs actifs, ce qui est pas tellement pratique.

J'ai pas mal parcouru internet mais pas véritablement trouvé de solution pour ça, c'est donc vers vous que je me tourne maintenant

Si vous aviez des pistes ou des idées je suis preneur.

Un grand merci d'avance,

**Philippe Tulliez** · 17/09/2017, 12h44

Bonjour,
Je n'ai pas examiné tout ton code mais il y a déjà une incohérence d'après mois avec les lignes 30 & 32
Tu ajoutes un nouveau classeur à la collection Workbooks et puis tu ouvres ce même classeur alors qu'il est déjà ouvert. Fais l'opération manuellement et tu verras que lorsque tu ouvres un nouveau classeur et que tu le renommes il est toujours là.
Pourrais-tu indiquer le numéro de la ligne où a lieu l'erreur et quel message tu reçois ?

J'ajouterais que les Select, Activate, etc. sont des méthodes inutiles avec le VBA pour lire et écrire dans des feuilles et de plus cela ralenti l'exécution des procédures

**Thallhos** · 17/09/2017, 12h52

Envoyé par Philippe Tulliez

Bonjour,
Je n'ai pas examiné tout ton code mais il y a déjà une incohérence d'après mois avec les lignes 30 & 32
Tu ajoutes un nouveau classeur à la collection Workbooks et puis tu ouvres ce même classeur alors qu'il est déjà ouvert. Fais l'opération manuellement et tu verras que lorsque tu ouvres un nouveau classeur et que tu le renommes il est toujours là.
Pourrais-tu indiquer le numéro de la ligne où a lieu l'erreur et quel message tu reçois ?

Bonjour Philippe,

Merci de ta réponse.

En fait ce code fonctionne à merveille et me permet de faire toutes les manipulations demandées. En revanche lorsque la macro est finie et que je veux modifier/supprimer mon dossier créé sur mon bureau, cela m'est impossible tant que je ne ferme pas les classeurs Excel ouverts.

Je n'ai pas examiné tout ton code mais il y a déjà une incohérence d'après mois avec les lignes 30 & 32
Tu ajoutes un nouveau classeur à la collection Workbooks et puis tu ouvres ce même classeur alors qu'il est déjà ouvert.

En fait l'idée de départ est de : créé un fichier Excel dans mon sous dossier, puis l'ouvrir pour le modifier.

Mais si je comprends bien le seul fait de le créé l'ouvre ? c'est bien cela ? Je pourrais donc l'activer avec un : Workbooks("Suivi Audits Externes.xlsx").activate ?

Théo

**Philippe Tulliez** · 17/09/2017, 14h10

Bonjour,

Mais si je comprends bien le seul fait de le créé l'ouvre ? c'est bien cela ?

Absolument
Petit exemple de code qui l'illustre bien

Code :

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

1
2
3
4
5
6
Sub t()
 Workbooks.Add
 MsgBox Workbooks(Workbooks.Count).Name
 Workbooks(Workbooks.Count).SaveAs "monNouveauClasseur", xlWorkbookDefault
 MsgBox Workbooks(Workbooks.Count).Name
End Sub

Je pourrais donc l'activer avec un : Workbooks("Suivi Audits Externes.xlsx").activate ?

Pourquoi l'activer, il est déjà actif.
Il suffit d'effectuer l'opération manuellement pour s'en rendre compte.

**Thallhos** · 17/09/2017, 14h57

Envoyé par Philippe Tulliez

Bonjour,

Absolument
Petit exemple de code qui l'illustre bien

Code :

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

1
2
3
4
5
6
Sub t()
 Workbooks.Add
 MsgBox Workbooks(Workbooks.Count).Name
 Workbooks(Workbooks.Count).SaveAs "monNouveauClasseur", xlWorkbookDefault
 MsgBox Workbooks(Workbooks.Count).Name
End Sub

Pourquoi l'activer, il est déjà actif.
Il suffit d'effectuer l'opération manuellement pour s'en rendre compte.

Top merci beaucoup, je vais essayer tout ça.

Rapide et efficace comme toujours cher Philippe

A bientôt

Modification-Suppression : Cette action ne peut être réalisée car le dossier est ouvert dans un autre program [XL-2010]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager