écraser un fichier pdf déjà ouvert

**BenoitL77** · 03/07/2020, 14h18

Bonjour Forum,
Avec le code ci dessous, je peux créer soit un fichier excel, soit un fichier pdf (selon choix dans un userbox) à partir de mon fichier de devisage.
Le fichier ainsi créé est purgé de toutes les formules de calcul, taux de marge etc... que je ne souhaite pas communiquer au client.
Cette manip peut être faite plusieurs fois, aux grès des modification apportées au devis.

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
Option Explicit
 
Private Sub CommandButton1_Click()
 
Dim Chemin, nom_fichier_B, classeur_tempo As String
Dim longueur_fichier As Long
Dim nouveau_fichier As String
Dim nom_fichier_source As String
Dim lastlig As Integer
 
ActiveWorkbook.Save
 
Chemin = ActiveWorkbook.Path
nom_fichier_source = ActiveWorkbook.Name
longueur_fichier = Len(nom_fichier_source)
 
Application.DisplayAlerts = False         ' supprime les boîtes de dialogues de confirmation d'enregistrement
 
 
    If Me.OptionButton1.Value = True Then   'si choix Excel
 
        On Error GoTo erreurpdp     'si pas de pdp, alors msg d'erreur et on sort
 
        'définir la dernière ligne de l'offre
        lastlig = Range("A:A").Find("pdp", LookIn:=xlFormulas, LookAt:=xlWhole).Row
 
        'définir chemin et nom du nv fichier excel
        nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
        nouveau_fichier = Chemin + "\" + nom_fichier_B      'le chemin et le nom du fichier B Budget
 
        Worksheets("Selection").Unprotect           'déprotéger  feuille Sélection le temps de la macro
 
        Worksheets("Selection").Copy                'copier l'onglet selection
            With ActiveWorkbook                     'la coller dans un nv fichier que l'on enregistre selon le nom défini au dessus
             .SaveAs Filename:=nouveau_fichier, FileFormat:=xlOpenXMLWorkbookMacroEnabled
            End With
 
        Workbooks(nom_fichier_B).Activate
 
        ActiveWorkbook.BreakLink Name:=nom_fichier_source, Type:=xlExcelLinks ' Rompt les liaisons
 
 
 
        'copier coller valeurs de l'offre
        Range("B4:D" & lastlig).Select
        Selection.Copy
        Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
            :=False, Transpose:=False
 
        'afficher les 3 lignes modèle et les supprimer
        Rows("1:4").Select
        Selection.EntireRow.Hidden = False
        Rows("1:3").Select
        Selection.Delete Shift:=xlUp
 
        'suppirmer les colonnes à droite de l'offre
        Columns("E:Z").Select
        Selection.Delete Shift:=xlToLeft
 
        'afficher colonne A et la supprimer
        Columns("A:B").Select
        Selection.EntireColumn.Hidden = False
        Columns("A:A").Select
        Selection.Delete Shift:=xlToLeft
 
        'enregistrer le fichier
        ActiveWorkbook.Save
        Unload Me
        MsgBox ActiveWorkbook.Name
        MsgBox ("Fichier Excel créé.")
 
        Workbooks(nom_fichier_source).Activate      're verrouiller la feuille Selection
        Worksheets("Selection").Protect DrawingObjects:=False, Contents:=True, Scenarios:= _
        True, AllowFormattingCells:=True, AllowFormattingRows:=True, _
        AllowInsertingRows:=True, AllowInsertingHyperlinks:=True, _
        AllowDeletingRows:=True, AllowSorting:=True
 
    ElseIf Me.OptionButton2.Value = True Then   'si choix pdf
 
        'définir chemin et nom du nv fichier pdf
        nom_fichier_source = Left(nom_fichier_source, longueur_fichier - 5) 'supprimer extension .xlsm
        longueur_fichier = Len(nom_fichier_source)
        nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
        nouveau_fichier = Chemin + "\" + nom_fichier_B
 
         With Worksheets("Selection")  'enregistré sous pdf et ouvrir le pdf la zone d'impression est définie dans l'excel
        .ExportAsFixedFormat Type:=xlTypePDF, Filename:=nouveau_fichier, Quality:=xlQualityStandard, _
        IncludeDocProperties:=True, IgnorePrintAreas:=False, OpenAfterPublish:=True
        End With
        'Workbooks(nom_fichier_source).Activate
        Unload Me
        MsgBox ("Fichier PDF créé sous : " & Chemin)
 
 
    Else                'si pas de choix
        MsgBox "Vous devez sélectionner un type de fichier."
        'Unload Me
        Exit Sub
 
    End If
 
        Application.DisplayAlerts = True
Exit Sub
 
erreurpdp:
MsgBox "Manque la borne ""pdp"" en colonne A. Génération du fichier Excel impossible."
Unload Me
 
End Sub

Pour la version Excel, ça marche impec, même si le fichier "purgé" existe déjà et même si il est ouvert.
Pour la version pdf, ça marche aussi, même si le fichier existe déjà, mais pas si celui ci est ouvert.

Que puis-je faire pour régler le pb?
Est ce qu'il y a une ligne de code à ajouter pour autoriser à écraser/remplacer le fichier ouvert?
Ou bien suis je obligé de faire plus compliqué, comme par exemple : tester avant si le fichier est ouvert, si oui le fermer.

Merci pour vos retours
Benoit

PS, correction : j'ai en fait le même pb si le fichier excel "purgé" est ouvert.

**Jean-Philippe André** · 03/07/2020, 14h57

Salut,

tu t'embarques sur des problématiques complexes à gérer du point de vue programmation d'une part, et des problématiques de travail connues.

Supprimer un classeur sur lequel tu es le seul à travailler, ca peut se voir, mais si c'est une autre personne qui l'utilise, tu vas galérer, car si on te donne un code qui force la fermeture suppression, ton collègue le vivra comment ?

Tu peux simplement faire des bouts de code qui te permettent d'anticiper l'erreur et d'afficher un message comme quoi le classeur est ouvert :

https://access.developpez.com/faq/?p...p#estFicOuvert

**Menhir** · 03/07/2020, 15h14

Envoyé par BenoitL77

Pour la version pdf, ça marche aussi, même si le fichier existe déjà, mais pas si celui ci est ouvert.

Ce n'est pas Excel mais le FileSystem qui bloque cet écrasement (et il a bien raison).
Je doute qu'un langage comme VBA soit capable de shunter cette protection.

La seule solution en VBA serait de fermer puis écraser (ou, mieux, renommer) l'ancien fichier avant de générer le nouveau.

**BenoitL77** · 03/07/2020, 15h25

Merci Messieurs pour vos retours.
J'ai du mal de faire simple... mais je me soigne
J'ai suivi le lien de Jean-Philippe et réussi à faire un test et message d'alerte pour le cas "excel".
Je m'attaque au cas "pdf" et clôturerais cette discussion une fois fait.

Encore MErci
Benoit

**BenoitL77** · 03/07/2020, 16h01

J'ai parlé trop vite...En ajoutant le test du pdf, j'ai mis un beau bazar.

Fichiers ouverts ou pas ...il me met toujours le message "ficheir déjà ouvert".
Question que doit-on tester? le nom du fichier? avec ou sans extension? avec ou sans le chemin?
Mes fichiers pdf et Excel ont le même nom, à l'extension prêt, ça peut jouer?

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
Option Explicit
 
Private Sub CommandButton1_Click()
 
Dim Chemin, nom_fichier_B, classeur_tempo As String
Dim longueur_fichier As Long
Dim nouveau_fichier As String
Dim nom_fichier_source As String
Dim lastlig As Integer
Dim test As Range
Dim fichieratest As String
 
'ActiveWorkbook.Save
 
Chemin = ActiveWorkbook.Path
nom_fichier_source = ActiveWorkbook.Name
longueur_fichier = Len(nom_fichier_source)
 
Application.DisplayAlerts = False         ' supprime les boîtes de dialogues de confirmation d'enregistrement
 
 
    If Me.OptionButton1.Value = True Then   'si choix Excel
 
        'définir chemin et nom du nv fichier excel
        nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
        nouveau_fichier = Chemin + "\" + nom_fichier_B      'le chemin et le nom du fichier B Budget
        fichieratest = nom_fichier_B
 
        'vérifier si fichier déjà ouvert
        If fichierouvert(fichieratest) = False Then
        MsgBox ("Le fichier " & fichieratest & " est déjà ouvert. Fermez le et recommencez.")
        Unload Me
        Application.DisplayAlerts = True    'rétablir message d'alerte
        Exit Sub
        End If
 
        .....
 
    ElseIf Me.OptionButton2.Value = True Then   'si choix pdf
 
        'définir chemin et nom du nv fichier pdf
        nom_fichier_source = Left(nom_fichier_source, longueur_fichier - 5) 'supprimer extension .xlsm
        longueur_fichier = Len(nom_fichier_source)
        nom_fichier_B = "B" + Right(nom_fichier_source, longueur_fichier - 1)
        nouveau_fichier = Chemin + "\" + nom_fichier_B
        fichieratest = nom_fichier_B + ".pdf"
 
        'vérifier si fichier déjà ouvert
        If fichierouvert(fichieratest) = False Then
        MsgBox ("Le fichier " & fichieratest & " est déjà ouvert. Fermez le et recommencez.")
        Unload Me
        Application.DisplayAlerts = True    'rétablir message d'alerte
        Exit Sub
        End If
 
......      
 
    Else                'si pas de choix
        MsgBox "Vous devez sélectionner un type de fichier."
        Exit Sub
 
    End If
 
Application.DisplayAlerts = True    'rétablir message d'alerte
 
End Sub
 
 
Function fichierouvert(ByVal fichieratest As String) As Boolean
    Dim fic As Integer
    Dim IsFileOpen As Boolean
    On Error Resume Next
 
    fic = FreeFile()
    Open fichieratest For Input Access Read Lock Read Write As fic
   MsgBox Err.Number
    If Err.Number = 0 Then
        fichierouvert = False
        Close fic
    Else
        fichierouvert = True
    End If
    MsgBox fichierouvert 
End Function

err.number est toujours = 53

J'ai sans doute codé des trucs pas clair... pourriez vous y jeter un oeil?

Merci d'avance
Benoit

**BenoitL77** · 03/07/2020, 16h17

bizarre, quand j'essaye d'ouvrir un fichier (Excel ou pdf)déjà ouvert, je n'ai aucun message d'erreur....

**Jean-Philippe André** · 03/07/2020, 17h18

Salut,

si je lis ton code

Code :

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

1
2
3
4
5
6
If fichierouvert(fichieratest) = False Then
        MsgBox ("Le fichier " & fichieratest & " est déjà ouvert. Fermez le et recommencez.")
        Unload Me
        Application.DisplayAlerts = True    'rétablir message d'alerte
        Exit Sub
        End If

C'est pas exactement le contraire (True au lieu de False)

écraser un fichier pdf déjà ouvert [XL-2019]

Macros et VBA Excel

Vue hybride

Discussions similaires

Partager

Partager