Macro fonctionne qu'une fois!!

[CMoa]

Bonjour
Cette macro ne fontionne q'une seule fois à l'ouverture du fichier et une autre fois sur un malentendu??
Quelqu'un aurait-il l'amabilité de me dire d'où vient l'erreur.
Merci pour vos réponses

Sub SignetsWord()
 'On Error Resume Next
  Dim wordApp As Word.Application
  Dim wordDoc As Word.Document
  Dim Fich As Worksheet
  Chemin2 = ThisWorkbook.Path & "\" & "Devis\"
  Dim AnyString, MyStr
  Set wordApp = CreateObject("Word.Application")
  AnyString = Chemin2 
  For n = 8 To Range("A500").End(xlUp).Row
   MyStr = Right(AnyString & Range("A" & n), 3)
If MyStr = "doc" Then
   On Error Resume Next
   mondocument = Chemin2 & Range("A" & n) 
    Set wordDoc = Documents.Open(Chemin2 & Range("A" & n))
  DoEvents
   Range("D" & n) = wordDoc.Bookmarks("Montant_ht").Range
  Range("E" & n) = wordDoc.Bookmarks("TVA").Range
 End If
 Next n
wordApp.Quit
End Sub

 

[MJ13]

Re : Macro fonctionne qu'une fois!!

Bonjour Cmoa

Peut-être un problème de on error resume next (à éviter si ta macro est betonnée).

 

[Cousinhub]

Re : Macro fonctionne qu'une fois!!

Bonjour,

je ne maîtrise pas trop les échanges avec Word, mais peut-être qu'en déchargeant ton wordApp et ton wordDoc en fin de code?

style :

'le code
Set wordApp = Nothing
Set wordDoc = Nothing
End Sub

Peut-être...

 

[CMoa]

Re : Macro fonctionne qu'une fois!!

Bonjour MJ13 et merci
Je commencais à désespérer.
Non ma macro n'est pas "bétonnée" puisque certaines cellules contiennent des noms ....xls.
Je ne coprends pas pourquoi cette erreur.
Si je met un arrêt dans la macro puis je la relance;elle repart aléatoirement.
Une autre idée?

 

[CMoa]

Re : Macro fonctionne qu'une fois!!

Bonjour bhbh
Merci pour ton aide.J'ai testé ton code mais c'est toujours pareil.
Une info supplémentaire:
Les fichiers word ouverts restent ouverts à la fin de la macro.
Je ne comprends plus rien.
Une autre idée?

 

[tototiti2008]

Re : Macro fonctionne qu'une fois!!

Bonjour à tous,

assez d'accord avec bh², Word doit encore être chargé en mémoire, voire le document...

Avant le wordApp.Quit, je mettrais bien un

wordDoc.Close False

puis les

Set wordApp = Nothing
Set wordDoc = Nothing

proposés par bh²

si ça plante encore, regarde si un processus Word reste ouvert dans le gestionnaire des tâches

 

[CMoa]

Re : Macro fonctionne qu'une fois!!

Bonjour tototiti2008
Merci pour ton aide.
J'ai aporté la modif et rien n'y fait.
Effectivement j'ai autant de Winword.exe dans le gestionnaire de tâches que de fichiers ouverts.

 

[Habitude]

Re : Macro fonctionne qu'une fois!!

Bonjour
Cette macro ne fontionne q'une seule fois à l'ouverture du fichier et une autre fois sur un malentendu??
Quelqu'un aurait-il l'amabilité de me dire d'où vient l'erreur.
Merci pour vos réponses

Sub SignetsWord()
 'On Error Resume Next
  Dim wordApp As Word.Application
  Dim wordDoc As Word.Document
  Dim Fich As Worksheet
  Chemin2 = ThisWorkbook.Path & "\" & "Devis\"
  Dim AnyString, MyStr
  Set wordApp = CreateObject("Word.Application")
  AnyString = Chemin2 
  For n = 8 To Range("A500").End(xlUp).Row
   MyStr = Right(AnyString & Range("A" & n), 3)
If MyStr = "doc" Then
   On Error Resume Next
   mondocument = Chemin2 & Range("A" & n) 
    Set wordDoc = Documents.Open(Chemin2 & Range("A" & n))
  DoEvents
   Range("D" & n) = wordDoc.Bookmarks("Montant_ht").Range
  Range("E" & n) = wordDoc.Bookmarks("TVA").Range
 End If
 Next n
wordApp.Quit
End Sub

CMoa
D'abord tu déclare un wordApp.

Dim wordApp As Word.Application

Tu lui affecte un autre objet *Cette ligne me semble inutile

Set wordApp = CreateObject("Word.Application")

Ensuite wordApp ne te sers plus sauf pour faire un Quit dessus
Donc tu quitte une application jamais ouverte


J'essaierais ceci
remplacer

Set wordDoc = Documents.Open(Chemin2 & Range("A" & n))

par

Set wordDoc = wordApp.Documents.Open(Chemin2 & Range("A" & n))

Ainsi ton
wordApp.Quit
fait plus de sens

 

[CMoa]

Re : Macro fonctionne qu'une fois!!

Bonjour Habitude,le fil
Merci pour ton aide.
Je déclare trop de variable qui ne sont pas terminé à la fin de la boucle
voici la solution:

Sub SignetsWord()
 'On Error Resume Next
  'Dim wordApp As Word.Application [COLOR="Red"]supprimée[/COLOR]  
'Dim wordDoc As Word.Document[COLOR="Red"]supprimée[/COLOR]  
  Dim Fich As Worksheet
  Set appWord = CreateObject("Word.Application")
  Chemin2 = ThisWorkbook.Path & "\" & "Devis\"
  Dim AnyString, MyStr
  AnyString = Chemin2 '& Range("A" & n)
  For n = 8 To Range("A500").End(xlUp).Row
     MyStr = Right(AnyString & Range("A" & n), 3)
If MyStr = "doc" Then

   'On Error Resume Next
  mondocument = Chemin2 & Range("A" & n)
    Set wordDoc = appWord.Documents.Open(mondocument, ReadOnly:=True) '(Chemin2 & Range("A" & n))
  DoEvents
   Range("D" & n) = wordDoc.Bookmarks("Montant_ht").Range
  Range("E" & n) = wordDoc.Bookmarks("TVA").Range
End If
 Next n
appWord.Quit
End Sub

Merci à tous