Fermer un document Word si celui-ci est déjà ouvert
Bonjour tout le monde,
J'ai un code Excel qui me permet d'exporter plusieurs données vers un document Word, qui me résume les infos importantes. Celui-ci fonctionne parfaitement cependant j'ai un problème, si je décide d'exporter mon Excel en Word, puis que je modifie le Excel et que je l'exporte une nouvelle fois, ma macro bug car il n'est pas capable de créer une copie d'un document déjà ouvert.
Ainsi je voudrai qu'il détecte si mon document est déjà ouvert, si oui alors il le ferme sinon il exécute la macro normalement. (Je précise que je ne veux pas fermer le document à la fin de ma macro car celui-ci a pour but d'être impriméquasiment tout de suite après).
Je vous mets mon code en dessous, il fonctionne seulement si le document est fermé. J'ai bien essayé de gérer la détection du fichier ouvert mais rien n'y fait la variable IsDocOpen est toujours False.
Sub RemplirChampWordDepuisExcel()
Dim WordApp As Object
Dim WordDoc As Object
Dim Index As String, Box As String, Brand As String, Name As String, ProductsW As String, Size As String, NetWeight As String, Weight As String
Dim ModificationDate As Date
Dim Price As Currency
Dim CostW As Range, RefW As Range
Dim FirstRowW As Long, LastRowW As Long, Deb As Long
Dim p As Integer
'Fixed Cells
Index = ActiveSheet.Name
Name = ActiveSheet.Range("B1").Value
Box = ActiveSheet.Range("C6").Value
Size = ActiveSheet.Range("C7").Value
Weight = ActiveSheet.Range("C9").Value
ModificationDate = Date
Debug.Print Name, Index, Box, Size, Weight, ModificationDate
Set CostW = ActiveSheet.Cells.Find("Suggested Sell Price")
Price = Cells(CostW.Row, 6)
' Chemin complet vers le fichier Word original
Dim originalFilePath As String
originalFilePath = "C:\Users\Quelquun\Documents\Template.docx"
' Chemin complet vers le dossier où la copie sera sauvegardée
Dim copyFolderPath As String
copyFolderPath = "C:\Users\Quelquun\Documents\"
' Nom du fichier de copie
Dim copyFileName As String
copyFileName = Index & "-" & Name
Debug.Print copyFileName
Dim IsDocOpen As Boolean
IsDocOpen = False
Dim doc As Object
On Error Resume Next
Set doc = WordApp.Documents(copyFileName & ".docx")
On Error GoTo 0
If Not doc Is Nothing Then
IsDocOpen = True
End If
Debug.Print "IsDocOpen = " & IsDocOpen
If IsDocOpen Then
doc.Close
End If
' Créer une copie du fichier Word
FileCopy originalFilePath, copyFolderPath & copyFileName & ".docx"
' Ouvrir la copie de Word
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Set WordDoc = WordApp.Documents.Open(copyFolderPath & copyFileName & ".docx")
' Accéder au signet et insérer la valeur
With WordDoc
.Bookmarks("Number").Range.Text = Index
.Bookmarks("Name").Range.Text = Name
.Bookmarks("Box").Range.Text = Box
.Bookmarks("Size").Range.Text = Size
.Bookmarks("Weight").Range.Text = Weight
.Bookmarks("Date").Range.Text = ModificationDate
.Bookmarks("Price").Range.Text = Price
End With
Set RefW = ActiveSheet.Columns("A:A").Find("1")
FirstRowW = RefW.Row + 1
LastRowW = Cells(RefW.Row, 2).End(xlDown).Row
With WordDoc
Deb = .Bookmarks("Products").Start
For p = FirstRowW To LastRowW
ProductsW = ProductsW & Cells(p, 2).Value
ProductsW = ProductsW & vbLf
Brand = Brand & Cells(p, 3).Value
Brand = Brand & vbLf
NetWeight = NetWeight & Cells(p, 5).Value
NetWeight = NetWeight & vbLf
Next
.Bookmarks("Products").Range.Text = ProductsW
.Bookmarks("Brand").Range.Text = Brand
.Bookmarks("NetWeight").Range.Text = NetWeight
End With
' Sauvegarder la copie modifiée et fermer Word
WordDoc.SaveAs Filename:=copyFolderPath & copyFileName & ".docx", FileFormat:=16
'WordApp.Activate
' Libérer les objets
Set WordDoc = Nothing
Set WordApp = Nothing
End SubBonjour Guguste,
Normal, vous mettez votre test avant d'avoir instancié l'application Word
Set WordApp = CreateObject("Word.Application")A+
Bonjour BrunoM45,
En effet j'ai corrigéce que tu m'as dit cependant ma variable IsDocOpen est toujours False, voici le nouveau code :
...
Set WordApp = CreateObject("Word.Application")
WordApp.Visible = True
Dim IsDocOpen As Boolean
IsDocOpen = False
Dim doc As Object
On Error Resume Next
Set doc = WordApp.Documents(copyFileName & ".docx")
On Error GoTo 0
If Not doc Is Nothing Then
IsDocOpen = True
End If
Debug.Print "IsDocOpen = " & IsDocOpen
If IsDocOpen Then
doc.Close
End If
' Créer une copie du fichier Word
FileCopy originalFilePath, copyFolderPath & copyFileName & ".docx"
' Ouvrir la copie de Word
Set WordDoc = WordApp.Documents.Open(copyFolderPath & copyFileName & ".docx")
' Accéder au signet et insérer la valeur
With WordDoc
.Bookmarks("Number").Range.Text = Index
.Bookmarks("Name").Range.Text = Name
.Bookmarks("Box").Range.Text = Box
.Bookmarks("Size").Range.Text = Size
.Bookmarks("Weight").Range.Text = Weight
.Bookmarks("Date").Range.Text = ModificationDate
.Bookmarks("Price").Range.Text = Price
End With
...