Tableau vers document word avec signets

Le 16/09/2021 à 17:18

Bonjour !

Débutante en VBA j'ai tenté de faire une macro qui permette de copier les tableaux en tant qu'image dans un document word à des endroits précis indiqués par des signets.

Pour l'instant le document s'ouvre mais les tableaux n'apparaissent pas et j'ai une erreur qui s'affiche "erreur d'execution 5941".

Quelqu'un a t-il une idée de ce qui cloche dans mon code ?

Merci

'EDITION DU RAPPORT WORD
Public Sub Edition_rapport()
'Ignore les erreurs rencontrés et poursuit la procédure
'On Error Resume Next
'Déclaration des variables

'Dim wordApp As Word.Application
'Dim wordDoc As Word.Document

Dim wordApp As Object
Dim wordDoc As Object

Dim largeur As Integer
Dim Chemin As String
Dim Text As String
Dim k As Integer
Dim i As Variant
Dim entree As String
Dim Graphique As String
Dim finput As FileDialog
Dim TdeBase As String
Dim Commentaire As String
Dim ReglementairePgm As String
Dim TableauNuméro1(1, 3) As Integer
Dim TableauNuméro2(1, 3) As Integer
Dim intT As Integer

rep = MsgBox("Vous êtes sur le point de lancer la création du rapport de votre étude." & vbCr & _
"Après ce message, si vous confirmez votre souhait de créer ce rapport, vous devez aller sélectionner la trame de rapport correspondante à la version de cet utilitaire que vous utilisez à l'aide de l'explorateur windows qui s'ouvrira." & vbCr & _
"Si vous ne connaissez pas le numéro de version de l'utilitaire que vous êtes en train d'utiliser, reportez-vous sur la feuille 'Accueil' qui l'indique ou vers votre responsable." & vbCr & _
"" & vbCr & _
"Souhaitez-vous créer le rapport de votre étude?", vbYesNo + vbQuestion, "Edition du pré-rapport de votre étude")
If rep = vbYes Then
'Ouverture de l'explorateur windows
Set finput = Application.FileDialog(msoFileDialogFilePicker)
finput.Show
With finput
Chemin = .SelectedItems(1)
End With
'Création du fichier word
Set wordApp = CreateObject("Word.Application")
wordApp.Visible = True
'ouverture du fichier word sélectionné
Set wordDoc = wordApp.Documents.Open(Chemin, ReadOnly:=True)

'--------------------------------------------------------------------------------------
' PROCEDURE DE COPIE DE GRAPHIQUES ET TABLEAUX DE RENDUS
'La procédure ViderPressePapier vide au fur et à mesure de la procédure le données copiée
' en mémoire tampon afin de permettre la copie totale des informations
'--------------------------------------------------------------------------------------

'ETAT DES LIEUX CLOS COUVERT
Call ViderPressePapier 'Vide le presse papier (macro dans le module 2)
On Error GoTo signet0
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="EDL_Facade" 'dans l'instance word, place le curseur au signet demandé
Worksheets("État des lieux_Clos couvert").Range("RapportTableauFacades").Copy 'dans l'instance excel, copie la plage nommée demandée
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Données Générales Synthèse
signet0:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet1
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDONNEES_GENERALES2" 'dans l'instance word, place le curseur au signet demandé
Worksheets("DONNEESGENERALES").Range("DONNEESGENERALES").Copy 'dans l'instance excel, copie la plage nommée demandée
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'DESCRIPTION CLOS ET COUVERT
signet1:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet1_1
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="EDL_Facade" 'dans l'instance word, place le curseur au signet demandé
Worksheets("État des lieux_Clos couvert").Range("RapportTableauFacades").Copy 'dans l'instance excel, copie la plage nommée demandée
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Consommations
signet1_1:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet2
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetCONSOMMATIONS1" 'dans l'instance word, place le curseur au signet demandé
Worksheets("CONSOMMATIONS").Range("CONSOMMATIONS").Copy 'dans l'instance excel, copie la plage nommée demandée
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet2:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet3
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme1"
Worksheets("DIAGRAMME").ChartObjects("Diagramme1").Chart.CopyPicture
'wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet3:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet4
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme2"
Worksheets("DIAGRAMME").ChartObjects("Diagramme2").Chart.CopyPicture
'wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet4:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet5
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme3"
Worksheets("DIAGRAMME").ChartObjects("Diagramme3").Chart.CopyPicture
'wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet5:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet6
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDOCDISPONIBLE"
Worksheets("DOCDISPONIBLES").Range("DOCDISPONIBLE").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet6:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet7
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme11"
Worksheets("DIAGRAMME").ChartObjects("Diagramme1").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet7:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet8
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme21"
Worksheets("DIAGRAMME").ChartObjects("Diagramme2").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet8:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet9
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDiagramme31"
Worksheets("DIAGRAMME").ChartObjects("Diagramme3").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet9:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet10
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDEPERDITIONS"
Worksheets("DEPERDITIONS").ChartObjects("DEPERDITIONSGRAPHE").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet10:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet11
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetDEPERDITIONS2"
Worksheets("DEPERDITIONS").Range("DEPERDITIONS").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet11:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet12
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetPOTENTIEL"
Worksheets("POTENTIEL").Range("POTENTIEL").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet12:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet13
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetELECTRICITE_CONSO"
Worksheets("CONSOMMATIONS2").ChartObjects("Electricite_Conso").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet13:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet15
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetCOMBUSTIBLE_CONSO"
If Worksheets("CONSOMMATIONS2").Range("E5") = 0 And Worksheets("CONSOMMATIONS2").Range("G5") = 0 Then
Worksheets("CONSOMMATIONS2").ChartObjects("Gaz_Conso").Chart.CopyPicture
Else
Worksheets("CONSOMMATIONS2").ChartObjects("Fioul_Conso").Chart.CopyPicture
End If
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'signet14:
'Call ViderPressePapier
'On Error GoTo -1
'On Error GoTo signet15
'wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetCOMBUSTIBLE_CONSO"
'Worksheets("CONSOMMATIONS2").ChartObjects("Fioul_Conso").Chart.CopyPicture
'wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet15:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet16
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetEAU_CONSO"
Worksheets("CONSOMMATIONS2").ChartObjects("Eau_Conso").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet16:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet17
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetELECTRICITE_FACTU"
Worksheets("CONSOMMATIONS2").ChartObjects("Electricite_Factu").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet17:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet19
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetCOMBUSTIBLE_FACTU"
If Worksheets("CONSOMMATIONS2").Range("E11") = 0 And Worksheets("CONSOMMATIONS2").Range("G11") = 0 Then
Worksheets("CONSOMMATIONS2").ChartObjects("Gaz_Factu").Chart.CopyPicture
Else
Worksheets("CONSOMMATIONS2").ChartObjects("Fioul_Factu").Chart.CopyPicture
End If
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'signet18:
'Call ViderPressePapier
'On Error GoTo -1
'On Error GoTo signet19
'wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetCOMBUSTIBLE_FACTU"
'Worksheets("CONSOMMATIONS2").ChartObjects("Fioul_Factu").Chart.CopyPicture
'wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
'wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet19:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet20
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetEAU_FACTU"
Worksheets("CONSOMMATIONS2").ChartObjects("Eau_Factu").Chart.CopyPicture
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet20:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet21
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetETIQUETTE"
Worksheets("ETIQUETTE").Range("ETIQUETTE").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False
signet21:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet22
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetUSAGES"
Worksheets("USAGES").Range("USAGES").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Inconfort ETE
signet22:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet23
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetINCONFORTETE"
Worksheets("INCONFORTS").Range("INCONFORTETE").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Inconfort HIVER
signet23:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet24
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetINCONFORTHIVER"
Worksheets("INCONFORTS").Range("INCONFORTHIVER").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Inconfort USAGE
signet24:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet25
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetINCONFORTUSAGE"
Worksheets("INCONFORTS").Range("INCONFORTUSAGE").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Inconfort DIVERS
signet25:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet26
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetINCONFORTDIVERS"
Worksheets("INCONFORTS").Range("INCONFORTDIVERS").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Ressources Energétiques
signet26:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet27
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetENERGIES"
Worksheets("ENERGIES").Range("ENERGIES").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

'Analyse Conso & Factures
signet27:
Call ViderPressePapier
On Error GoTo -1
On Error GoTo signet28
wordApp.Selection.Goto What:=wdGoToBookmark, Name:="SignetANALYSE_CONSO"
Worksheets("CONSOMMATIONS2").Range("ANALYSE_CONSO").Copy
wordApp.Selection.ParagraphFormat.Alignment = wdAlignParagraphCenter
wordApp.Selection.PasteSpecial Link:=False, DataType:=wdPasteEnhancedMetafile, Placement:=wdInLine, DisplayAsIcon:=False

signet28:
'Retour sur la feuille Menu
Worksheets("ACCUEIL").Select
'Mettre la table à jour
wordApp.WordBasic.UpdateTableOfContents
'Afficher la fenêtre enregistrer sous
wordApp.Dialogs(wdDialogFileSaveAs).Show
Application.ScreenUpdating = True
End If

End Sub

Le 17/09/2021 à 14:46

Bonjour,

Flemme de lire le code proposé, alors voici une démo simplette :

* 2 boutons :

* le bouton "créer" => pour créer un doc word contenant un signet

* le bouton "modifier" => pour modifier le doc word précédemment créé en y ajoutant au signet un tableau correspondant à la plage A1:E6 de la Feuil1

Le code pour insérer le tableau est très simple :

Sub Demo_Modif_Word()
Dim Rep As String, ndf As String

    Rep = ThisWorkbook.Path & "\Word\"
    ndf = Rep & "Démo_Tableau.docx"
    Verif_Rep Rep
    If Exist_Fichier(ndf) Then
        Open_Word ndf, False

        '' copie le tableau vers le signet
        Copie_tblo_signet "Signet_pour_tableau", Sheets("Feuil1").Range("A1:E6")

        WordDoc.Application.ActiveDocument.SaveAs (ndf)
        Close_Word
        MsgBox "Document Word modifié!"
    End If
End Sub

Souhaitant que ça puisse servir

Pierre

demo-creer-ou-modif-word-sept2021.xlsm (39.38 Ko)

Rechercher des sujets similaires à "tableau document word signets"