Discussion :

[jfchappuis]

Bonjour,

j'ai une Routine qui copie 19 éléments Texte ou graphique d'Excel dans Word. Parfois, (environ 1 fois sur 10) le programme plante Avec une erreur 4605, "Presse-papier vide ou non valide".

J'ai implémenté une gestion d'erreur et à ce Moment là, le programme plante toujours mais avec une erreur 0.

J'ai remarqué que cette erreur se produit en général lorsque le processus Excel.exe commence à dépasser 28 MB en mémoire vive

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
Public Sub WordErstellen()
 
'table des relations
'les signets Word portent les mêmes noms que les Nom définis dans Excel
 
Dim rngSource() As Excel.Range
Dim rngQuelleName As Excel.Range
Dim inbQuelle As Integer
Dim wksProv As Worksheet
Dim strSheet As String
Dim strRange As String
Dim strDatei As String
Dim strTyp() As String
Dim bytLoop As Byte
Dim wdRg As Word.Range
Dim appWD As Word.Application
Dim doc As Word.Document
Dim i As Integer
 
   On Error GoTo WordErstellen_Error
 
dlgwait.Show vbModeless
dlgwait.controlBar.Caption = "ù"
 
'routine à désactiver après construction du UserForm
If wkbRoot Is Nothing Then
    Call InitializeWKB
End If
 
dlgwait.lblAction.Caption = "Read parameters"
'objets internes (préalablement publics)
Set wksRoot_Diagramme = wkbRoot.Worksheets("Diagramme")
Set wksRoot_Tabelle = wkbRoot.Worksheets("Tabellen")
strVorlagePfad = ReadConfigWert("Vorlage", 1)
strVorlage = ReadConfigWert("Vorlage", 2)
 
 
Set rngQuelleName = wksRoot_Hilfsregister.Range("Verknüpfungsobjekte")
inbQuelle = rngQuelleName.Rows.Count
 
 
ReDim rngSource(1 To inbQuelle)
ReDim strTyp(1 To inbQuelle)
 
 
For i = 1 To inbQuelle
 
    'lit la valeur de la feuille et de la plage
    strSheet = rngQuelleName.Cells(i, 2).Value
    strRange = rngQuelleName.Cells(i, 1).Value
    strTyp(i) = rngQuelleName.Cells(i, 3).Value
    'affecte la valeur de la plage à l'objet
    Set rngSource(i) = Worksheets(strSheet).Range(strRange)
Next i
 
Set rngQuelleName = Nothing
 
dlgwait.lblAction.Caption = "Start MS Word"
 
'démarre Word et crée un document depuis le modèle
Set appWD = CreateObject("Word.Application")
appWD.Visible = True
dlgwait.lblAction.Caption = "Open MS Word Template"
 
Set doc = appWD.Documents.Add(Template:=strVorlagePfad & strVorlage, NewTemplate:=False, DocumentType:=0)
 
'Application.ScreenUpdating = False
 
'parcourt la collection des objets à copier
For i = 1 To inbQuelle
    'réinitialisation du compteur
    bytLoop = 0
RepriseCopie:
    dlgwait.lblAction.Caption = rngSource(i).Name.NameLocal & " copy/paste, loop: " & bytLoop
 
    rngSource(i).Parent.Select
   'sélectionne la cellule A1 de la feuille (ainsi sort du mode graphique)
    rngSource(i).Parent.Range("A1").Select
 
 
    'copie la source dans le presse-papier
     rngSource(i).Copy
 
    'atteint le signet (l'utilisateur voit le déroulement) dans Word et colle
    doc.Bookmarks(rngSource(i).Name.NameLocal).Select 'cette opération peut sans autre être mise en commentaire
    Set wdRg = doc.Bookmarks(rngSource(i).Name.NameLocal).Range
 
    'selon le type d'objet, colle un RTF ou un objet Excel. Permet de réduire la taille du Word et la rapidité des collages
 
'''' PLANTAGE ICI
 
   Select Case strTyp(i)
   Case "Object"
        wdRg.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
    Case "Text"
        wdRg.PasteSpecial Link:=False, DataType:=wdPasteRTF, Placement:=wdInLine, DisplayAsIcon:=False
    End Select
    dlgwait.controlBar.Caption = "w" & dlgwait.controlBar.Caption
 
Next i
 
'redimensionne et ferme les variables
ReDim rngSource(0)
Set wdRg = Nothing
Call ClearClipboard
 
'sauvegarde du document
    'construction du nom de fichier et sauvegarde
    dlgwait.lblAction.Caption = "Save Word document"
    strDatei = ReadConfigWert("VorschauPfad", 1) & wksRoot_Hilfsregister.Range("NR_RevDatumVortag").Value & ReadConfigWert("VorschauPfad", 2)
    doc.SaveAs2 strDatei
 
'fermeture de Word
  doc.Close False
dlgwait.controlBar.Caption = "w" & dlgwait.controlBar.Caption
 
appWD.Quit
dlgwait.Hide
 
 
 
 
   Exit Sub
 
WordErstellen_Error:
   If Err.Number = 4605 Or Err.Number = 0 Then
        If bytLoop < 3 Then
            bytLoop = bytLoop + 1
 
            GoTo RepriseCopie
        End If
   Else
        On Error Resume Next
        dlgwait.Hide
        doc.Close False
        appWD.Quit
 
 
 
      MsgBox "Fehler Nummer: " & Err.Number & vbCrLf & "Fehlerbeschreibung: " & Err.Description _
        & vbCrLf & vbCrLf & _
        "Module WordInterface, WordErstellen()" _
        & vbCrLf & vbCrLf & _
        "Bitte Fehlermeldung als Printscreen an red@sbb.ch senden.", 16, "Unbekannter Fehler"
 
 
   End If
 
 
 
 
End Sub

Mon idée est plutôt que passer par une gestion d'erreur, de tester le presse-papier avant de faire le coller et si le presse-papier est vide ou invalide, de refaire un copier ou de forcer le système à attendre.

J'avais mis un DoEvents après l'action copier, mais cela n'a rien changé.

merci de vos lumineux Conseils.

J'ai vu sur un Post que Zellinho avait eu le même problème, mais la résolution n'est pas décrite...

[Nico Chg]

Bonjour,

Peux tu poster le code associé à la procédure "ClearClipboard" ?

Sinon, essaie d'appeller ClearClipboard à chaque itérations plutôt qu'a la fin de la boucle ?

[jfchappuis]

Voici la Routine clearclipboard.

Elle vide le presse-papier Windows et désactive le mode Copie dans Excel.

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
13
 
Private Declare Function OpenClipboard Lib "user32" (hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
 
Public Sub ClearClipboard()
    If OpenClipboard(0&) <> 0 Then
        EmptyClipboard
        CloseClipboard
    End If
    Application.CutCopyMode = False
End Sub

Je l'avais mise au départ à chaque itération, le problème était le même, j'avais contrôlé en debug, la mémoire vive occupée, sans grande amélioration, pour ces deux raisons,je l'ai déplacée en fin de routine

[Nico Chg]

As-tu vérifier que la condition OpenClipboard de ta fonction était active à chaque fois ?
J'utilise exactement la même fonction, sans la condition, et je n'ai jamais eu de problème

Code :

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

1
2
3
4
5
6
7
8
9
10
Option Explicit
Private Declare Function OpenClipboard Lib "user32" (ByVal hWnd As Long) As Long
Private Declare Function CloseClipboard Lib "user32" () As Long
Private Declare Function EmptyClipboard Lib "user32" () As Long
 
Sub Clear_Clipboard()
    OpenClipboard 0
    EmptyClipboard
    CloseClipboard
End Sub

[jfchappuis]

Salut,

J'ai corrigé ma Routine Clearclipboard comme conseillé (sans test) et je l'appelle juste avant de faire le copy.

Je viens de tester ma Routine 12 fois, elle n'a jamais planté.

Merci beaucoup

[Nico Chg]

Super !

Bon courage pour la suite

[jfchappuis]

Rebonjour,

Après une journée passé à développer et utiliser passablement Excel, le problème redémarre (erreur 4605).

La solution est de fermer Excel et de redémarrer Excel et le problème est résolu pour un certain temps. Mon souci est que cette routine va être utilisée une fois par jour dans un autre service avec de nombreux utilisateurs. Je vais leur recommander de démarrer dans cette routine dans une nouvelle instance d'Excel, mais je connais bien les utilisateurs et leur rigueur.

J'ai beau mettre une gestion d'erreur en place et tester l'erreur 4605et recommencer la routine, le problème ignore la gestion d'erreur et affiche la fenêtre de débogage

Si quelqu'un a un bout de code pour vérifier si le presse-papier est valide, je suis preneur

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
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
Public Sub WordErstellen()
 
'table des relations
'les signets Word portent les mêmes noms que les Nom définis dans Excel
 
Dim rngSource() As Excel.Range
Dim rngQuelleName As Excel.Range
Dim inbQuelle As Integer
Dim wksProv As Worksheet
Dim strSheet As String
Dim strRange As String
Dim strDatei As String
Dim strTyp() As String
Dim bytLoop As Byte
Dim strBookmark As String
Dim wdRg As Word.Range
Dim appwd As Word.Application
Dim doc As Word.Document
Dim i As Integer
Dim lngPosExcl As Long
 
 
   On Error GoTo WordErstellen_Error
 
dlgwait.Show vbModeless
dlgwait.controlBar.Caption = "ù"
Application.Cursor = xlWait
 
'routine à désactiver après construction du UserForm
If wkbRoot Is Nothing Then
    Call InitializeWKB
End If
 
dlgwait.lblAction.Caption = "Read parameters"
'objets internes (préalablement publics)
Set wksRoot_Diagramme = wkbRoot.Worksheets("Diagramme")
Set wksRoot_Tabelle = wkbRoot.Worksheets("Tabellen")
strVorlagePfad = ReadConfigWert("Vorlage", 1)
strVorlage = ReadConfigWert("Vorlage", 2)
 
 
Set rngQuelleName = wksRoot_Hilfsregister.Range("Verknüpfungsobjekte")
inbQuelle = rngQuelleName.Rows.Count
 
 
ReDim rngSource(1 To inbQuelle)
ReDim strTyp(1 To inbQuelle)
 
 
For i = 1 To inbQuelle
 
    'lit la valeur de la feuille et de la plage
    strSheet = rngQuelleName.Cells(i, 2).Value
    strRange = rngQuelleName.Cells(i, 1).Value
    strTyp(i) = rngQuelleName.Cells(i, 3).Value
    'affecte la valeur de la plage à l'objet
    Set rngSource(i) = Worksheets(strSheet).Range(strRange)
Next i
 
Set rngQuelleName = Nothing
 
dlgwait.lblAction.Caption = "Start MS Word"
 
'démarre Word et crée un document depuis le modèle
Set appwd = CreateObject("Word.Application")
appwd.Visible = False
dlgwait.lblAction.Caption = "Open MS Word Template"
 
Set doc = appwd.Documents.Add(Template:=strVorlagePfad & strVorlage, NewTemplate:=False, DocumentType:=0)
 
'Application.ScreenUpdating = False
'parcourt la collection des objets à copier
For i = 1 To inbQuelle
    'réinitialisation du compteur
    bytLoop = 0
RepriseCopie:
    dlgwait.lblAction.Caption = rngSource(i).Name.NameLocal & " copy/paste, loop: " & bytLoop
 
    rngSource(i).Parent.Select
   'sélectionne la cellule A1 de la feuille (ainsi sort du mode graphique)
    rngSource(i).Parent.Range("A1").Select
 
    Call ClearClipboard
 
 
    'copie la source dans le presse-papier
     rngSource(i).Copy
 
    'définit le nom du signet
    strBookmark = rngSource(i).Name.NameLocal
    'remplace le nom du registre, si le signet est défini au niveau du registre et pas au niveau du classeur
    lngPosExcl = InStr(1, strBookmark, "!")
    strBookmark = Mid(strBookmark, lngPosExcl + 1)
 
    'atteint le signet (l'utilisateur voit le déroulement) dans Word et colle
    doc.Bookmarks(strBookmark).Select 'cette opération peut sans autre être mise en commentaire
    Set wdRg = doc.Bookmarks(strBookmark).Range
 
 
    'selon le type d'objet, colle un RTF ou un objet Excel. Permet de réduire la taille du Word et la rapidité des collages
   Select Case strTyp(i)
   Case "Object"
       wdRg.PasteSpecial Link:=False, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
    Case "Text"
        wdRg.PasteSpecial Link:=False, DataType:=wdPasteRTF, Placement:=wdInLine, DisplayAsIcon:=False
    End Select
    dlgwait.controlBar.Caption = "w" & dlgwait.controlBar.Caption
 
Next i
 
'redimensionne et ferme les variables
ReDim rngSource(0)
Set wdRg = Nothing
Call ClearClipboard
 
'sauvegarde du document
    'construction du nom de fichier et sauvegarde
    dlgwait.lblAction.Caption = "Save Word document"
    strDatei = ReadConfigWert("VorschauPfad", 1) & wksRoot_Hilfsregister.Range("NR_RevDatumVortag").Value & ReadConfigWert("VorschauPfad", 2)
    doc.SaveAs2 strDatei
 
'fermeture de Word
  doc.Close False
dlgwait.controlBar.Caption = "w" & dlgwait.controlBar.Caption
 
appwd.Quit
dlgwait.Hide
 
'Fehlerlog abfüllen (Zeitpunkt der Worddatei Erstellung, Dateiname)
wksRoot_Fehlerlog.Range("NR_LetztesWordDoc").Value = strDatei
wksRoot_Fehlerlog.Range("NR_LetztesWordDocSendDatum").Value = Format(Date, "dd.mm.yyyy")
wksRoot_Fehlerlog.Range("NR_LetztesWordDocSendDatumZeit").Value = Format(VBA.Time, "hh:mm:ss")
 
wksRoot_Fehlerlog.Range("NR_Status").Value = 2
 
'Status Update des Textfeldes txtStatus auf Userform
Call Status(wksRoot_Fehlerlog.Range("NR_Status").Value)
 
Application.Cursor = xlDefault
   Exit Sub
 
WordErstellen_Error:
   If Err.Number = 4605 Or Err.Number = 0 Then
        If bytLoop < 3 Then
            bytLoop = bytLoop + 1
 
            GoTo RepriseCopie
        End If
   Else
        On Error Resume Next
        dlgwait.Hide
        doc.Close False
        appwd.Quit
        Application.Cursor = xlDefault
 
      MsgBox "Fehler Nummer: " & Err.Number & vbCrLf & "Fehlerbeschreibung: " & Err.Description _
        & vbCrLf & vbCrLf & _
        "Module WordInterface, WordErstellen()" _
        & vbCrLf & vbCrLf & _
        "Bitte Fehlermeldung als Printscreen an red@sbb.ch senden.", 16, "Unbekannter Fehler"
   End If
 
End Sub

Merci d'avance

[patricktoulon]

Bonjour j'ai eu le meme soucis l'ors de copypicture de shapes par serie

alors des fois nickel des fois erreur
la seule solution
api sleep a chaque iteration voir placer un doevents au bon moment laisse le temps au clipboard de digérer l'information

voila ou est le soucis
Au plaisir

[LaureneW]

Bonjour !
Je relance cette vieille discussion, j'ai également le problème de presse papier invalide ou vide qui bug aléatoirement...
J'ai suivi vos conseils et j'ai mis un temps d'attente d'une seconde devant chaque copie de tableau (cf code ci dessous) :

Code :

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

1
2
3
4
5
6
7
8
9
10
11
12
 
      WordApp.Selection.Sheets("Restitution - aujourdhui").Range("B4:i41").Copy
     'recherche du signet
        WordApp.Selection.Goto What:=wdGoToBookmark, Name:="C_periode6_Revenus_tableau"
        Application.Wait Time + TimeSerial(0, 0, 1)
        WordApp.Selection.Paste
        WordApp.Selection.PageSetup.Orientation = wdOrientLandscape
 
    'mise en forme du tableau sur Word
        WordApp.Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
        WordApp.Selection.Tables(1).AutoFitBehavior (wdAutoFitWindow)
        WordApp.Selection.Tables(1).Style = "Tableau Grille*4 - Accentuation*1"

J'ai une 15aine de copie de tableaux comme cela. Après 20 tentatives sans bug, j'ai eu espoir d'avoir résolu le problème mais le bug est revenu. Avez-vous des idées ? Est-ce que vous pensez qu'une seconde n’est pas suffisant ?
Merci pour vos réponses !

[LaureneW]

Personne ?