Discussion :

[haydens]

Bonjour a tous,

J'ai un code qui ne marche qu'une seule fois. Je suis obliger de fermer et réouvrir.
Je pense qu'il y a un truc que je ne ferme pas correctement.

La ligne qui plante est :

Code :

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

NbSection = ActiveDocument.Sections.Count

Et l'erreur me dit:

Le serveur distant n'existe pas pas ou n'est pas disponible

De plus il y a souvent un plantage de word "Not responding" quand j'execute le code d'un coup.
Si je fais pas a pas pour les premiere boucle et que je lance tout le reste d'un coup alors ça marche bien.
J'ai bien essayé de résoudre ce probleme avec les DoEvents et application.wait mais rien à faire.

Voici le 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
Sub SplitFichierWordPublipostage()
 
    Dim NomDeMonFichier_Dico As Dictionary
    Dim ListeNom_Rg As Range
 
    Dim objWord As New Word.Application
 
    Dim NbSection As Long
    Dim i As Long
    Dim s As Double
 
    Set NomDeMonFichier_Dico = CreationEtVerifNomFichier
 
    objWord.Documents.Open Range("CHEMIN_SOURCE").Offset(, 1).Value & "\" & Range("NOM_SOURCE").Offset(, 1).Value
    objWord.Visible = True
    objWord.Activate
 
    NbSection = ActiveDocument.Sections.Count
 
    For i = 1 To NbSection - 1
 
        objWord.Selection.Goto What:=wdGoToSection, Which:=wdGoToFirst, Count:=i, Name:=""
        objWord.Selection.SetRange objWord.Selection.Start, objWord.Selection.Goto(wdGoToSection, wdGoToNext, 1).End
        objWord.Selection.Copy
        objWord.Documents.Add
        objWord.Selection.Paste
        objWord.Selection.TypeBackspace
        objWord.Selection.Delete Unit:=wdCharacter, Count:=1
        ChangeFileOpenDirectory Range("CHEMIN_SAUVEGARDE").Offset(, 1).Value
        ActiveDocument.SaveAs Filename:=NomDeMonFichier_Dico(i) & ".docx"
 
        s = DoEvents
        ActiveDocument.Close
        s = DoEvents
        Application.Wait Now + TimeValue("00:00:02")
 
    Next i
 
    objWord.Documents(1).Close
    objWord.Quit
    Set objWord = Nothing
 
End Sub

Merci d'avance

[haydens]

Re Bonjour,

en fait le véritable problème est l'erreur:
"Le serveur distant n'existe pas pas ou n'est pas disponible"

Pour le reste c'est peut etre mon PC qui est lent ...

Quand j'ai cette erreur je clique sur "Fin" et je relance la macro et ça remarche mais c'est quand meme pas tres satisfaisant pour les utilisateurs ...

Si quelqu'un peut m'aider

Merci