Discussion :

[marcds31]

Bonjour,

Je débute en VBA, j'apprends à le faire en autodidacte du coup je ne pense pas ecrire le code de la meilleure façon, cela étant voici mon probleme.
J'ai un fichier word qui contient des images et des tableaux ainsi que du texte, et je cherche à intégrer dans ce fichier des tableaux d'un fichier excel (ce fichier à N (variable) onglets) les tableaux n'ont pas forcément la même taille.
Les tableaux sont copiés/collés dans le word à un emplacement précis (j'utilise des mots clés intégrés au texte du fichier, exemple <motcle> et <motcle\>)

Mon problème est le suivant, lorsque je suis en pas à pas, il n'y a pas de réel soucis, l'exportation vers word fonctionne, par contre si je me place comme un utilisateur lambda, j'ai une erreur de clipboard erreur 4605 que je ne comprends pas
Auparavant j'utilisais le PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False mais j'ai un souci d'ordre cosmétique en effet les tableaux arrivent avec des tailles qui ne conviennent pas et je ne sais pas comment les tailler (autofit) à la largeur de la page.
Avec PasteExcelTable cela semble mieux, mais je perds la mise en page (couleur, alignement, etc...) et lorsque je ne suis pas en pas à pas j'ai l'erreur 4605 qui plante le script

Voici le code, si une âme charitable peut m'aider

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
    Dim ExcelApp As Excel.Application
    Dim SelDOCFile As Selection
    Dim WordApp As Word.Application
    Dim WordDoc As Word.Document
    Dim User As String, File_Word As String, Filename As String
    Dim Change As Boolean, REGMAP_Balise As Boolean, REGMAPDFT_Balise As Boolean, OTPMAP_Balise As Boolean
    Change = False
    REGMAP_Balise = False
    REGMAPDFT_Balise = False
    OTPMAP_Balise = False
 
    User = Environ("userprofile")
    User = Split(User, "\")(UBound(Split(User, "\")))
    MsgBox ("Bonjour " & User & Chr(10) & "Veuillez sélectionner le fichier Word PTS")
    Change = False
 
    ChDir ActiveWorkbook.Path
 
    File_Word = Application.GetOpenFilename("Document Word, *.doc;*.docm;*.docx")
    If Split(File_Word, "\")(UBound(Split(File_Word, "\"))) = False Then
        MsgBox ("Abandon")
        Exit Sub
    End If
    Filename = Split(File_Word, "\")(UBound(Split(File_Word, "\")))
 
    'nécéssite d'activer la reference Microsoft word xx.x 0bject Library
    On Error Resume Next
        Set WordApp = GetObject(, "Word.Application")
        Set WordDoc = WordApp.Documents.Open(File_Word)
        Set ExcelApp = GetObject(, "Excel.Application")
    On Error GoTo 0
 
    'Traitement différent si le document est déjà ouvert
    If WordDoc Is Nothing Then
        'le document est fermé
        Set WordApp = CreateObject("Word.Application")
        WordApp.Visible = True
        Set WordDoc = WordApp.Documents.Open(Filename:=File_Word)
        WordApp.Documents(File_Word).Activate
    Else
        'Le document est ouvert
        WordApp.Documents(File_Word).Activate
    End If
 
    On Error Resume Next
    CaptionLabels.Add Name:="[Table"
    On Error GoTo errorHandler
 
    Set SelDOCFile = WordApp.Selection

là il s'agit donc de la partie déclaration etc...

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
    'ClearClipboard
    'On colle les tableaux
    SelDOCFile.HomeKey Unit:=wdStory ' place le cursaur en debut du document
    With SelDOCFile.Find
        .Forward = True
        .Wrap = wdFindContinue
        .Execute FindText:="\<motcle\>"
        If .Found And REGMAP_Balise Then
            Change = True
            SelDOCFile.MoveRight Unit:=wdCharacter, Count:=1
            SelDOCFile.TypeParagraph
            For Each WS In ExcelApp.ActiveWorkbook.Sheets
                If WS.Name = "REGMAP" Then
                    SelDOCFile.TypeParagraph
                    SelDOCFile.MoveUp Count:=1
                    SelDOCFile.InsertCaption Label:="[Table", Title:=": REGMAP]", Position:=wdCaptionPositionAbove, ExcludeLabel:=0
                    SelDOCFile.MoveRight Unit:=wdCharacter, Count:=1
                    TabDim = "B2:F" & ExcelApp.Sheets(WS.Name).Range("B2").End(xlDown).Row
                    ExcelApp.Sheets(WS.Name).Range(TabDim).Copy
                    'WordApp.Selection.PasteSpecial Link:=True, DataType:=wdPasteOLEObject, Placement:=wdInLine, DisplayAsIcon:=False
                    SelDOCFile.PasteExcelTable False, True, False
                    SelDOCFile.TypeParagraph
                 Else
                    SelDOCFile.TypeParagraph
                    SelDOCFile.MoveUp Count:=1
                    SelDOCFile.InsertCaption Label:="[Table", Title:=": " & ExcelApp.Sheets(WS.Name).Range("D4").Value, Position:=wdCaptionPositionAbove, ExcludeLabel:=0
                    SelDOCFile.MoveRight Unit:=wdCharacter, Count:=1
                    Reglength = Len(Split(ExcelApp.Sheets(WS.Name).Range("H5").Value, "b")(0))
                    TabDim = "B4:H" & Reglength + 4 + 3
                    ExcelApp.Sheets(WS.Name).Range(TabDim).Copy
                    SelDOCFile.PasteExcelTable False, True, False
                    SelDOCFile.TypeParagraph
                End If
            Next
        End If
    End With

c'est ici que le code plante lors du paste, auparavant je retouche le document word, mais cela n'a pas d'importance ici.

j'ai essayé de mettre ça pour bien vider le pressepapier, mais rien y fait

Code :

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

1
2
3
4
5
6
7
8
9
Sub ClearClipboard()
Dim oDataObject As DataObject
 
Set oDataObject = New DataObject
oDataObject.SetText ""
oDataObject.PutInClipboard
 
Set oDataObject = Nothing
End Sub

D'ailleurs est-il possible de modifier les paramètres du tableau qui est importé (copié/collé) ? car si j'ai compris il faut connaitre l'indice du tableau, mais dans mon cas cela est assez problématique (sans partir dans une usine à gaz ce que j'ai l'impression d'avoir déjà fait)

[clementmarcotte]

Bonjour,

Cela fait trop longtemps que je n'ai pas joué avec le copier coller, mais, VBA peut utiliser deux presse-papiers. Le presse-papier de Windows pour une seule entrée, et le presse-papier d'Office. (plusieurs entrées, partagé entre les applications Office et exclusif à Office.

Mais, tu peux toujours formater ton tableau dans Word, avec VBA.

[marcds31]

j'ai essayé d'inclure des DoEvents pour laisser le temps aux différentes fonctions de bien terminer, il y a un léger mieux, mais j'ai toujours l'erreur qui arrive, cela dit elle peut varier entre le presse papier soi-disant vide ou corrompu, soit la methode PasteExcelTable fail

Je vais finir en PLS sous mon bureau

[marcds31]

Bon c'est très sale.

J'ai remarqué en faisant un pas à pas et en retirant la gestion d'erreur, lorsque l'erreur survient (le presse papier pas comme il faut) si j'insiste en pressant F8, et bien au deuxieme coup ça fonctionne le paste s'opère correctement...

du coup

Code :

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

1
2
3
4
5
6
7
8
9
 
ErrorHandler:
    'indique le numéro et la description de l'erreur survenue
    Dim MonResultat
    If Err.Number = 4605 Then
        Resume
    Else
        MonResultat = MsgBox("Erreur n° " & Err.Number & vbCrLf & "Description : " & Err.Description, vbCritical + vbOKOnly, "Erreur d'execution")
    End If

j'ai mis ça, et cela fonctionne, mais ça ne me va pas du tout, c'est bourrin et puis j'ai pas compris ce qui ne va pas au final.
Alors pour le moment je ne mets pas résolu, parce que c'est de la merde disons le franchement, mais ça me retire une épine du pied (espérons temporairement), si quelqu'un à l'oeil affuté trouve le souci je suis preneur de l'information.