XL 2019 vba excel : masquer un tableau word

CBX

XLDnaute Nouveau
Bonjour à vous,

J'ai besoin de piloter un fichier word à partir de macro excel.
Le fichier word contient 4 tableaux que je souhaite afficher ou masquer selon certains critères.

Le code worddoc.Tables(1).delete fonctionne bien, MAIS du coup mon tableau 2 devient mon tableau 1 , je n'ai donc plus l'affichage souhaité pour les critères d'affichage du tableau 2.

J'ai tenté de contourner ce problème avec : worddoc.Tables(1).Visible = False mais là cela ne fonctionne pas avec un message d'erreur : "Erreur de compilation : membre de méthode ou de données introuvable".

Est ce que l'un d'entre vous aurait une solution ou une meilleure proposition ?

Merci beaucoup
 

Modeste geedee

XLDnaute Barbatruc
Bonjour à vous,

J'ai besoin de piloter un fichier word à partir de macro excel.
Le fichier word contient 4 tableaux que je souhaite afficher ou masquer selon certains critères.

Le code worddoc.Tables(1).delete fonctionne bien, MAIS du coup mon tableau 2 devient mon tableau 1 , je n'ai donc plus l'affichage souhaité pour les critères d'affichage du tableau 2.

J'ai tenté de contourner ce problème avec : worddoc.Tables(1).Visible = False mais là cela ne fonctionne pas avec un message d'erreur : "Erreur de compilation : membre de méthode ou de données introuvable".

Est ce que l'un d'entre vous aurait une solution ou une meilleure proposition ?

Merci beaucoup
Bonsour,
😎
Nommer ou Renommer les tableaux ...
 

job75

XLDnaute Barbatruc
Bonjour le forum,

Téléchargez les fichiers joints dans le même dossier (le bureau).

La macro dans le code de l'UserForm :
VB:
Private Sub CommandButton1_Click()
Dim Wapp As Object, Wdoc As Object, hligne, n, i
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
On Error GoTo 0
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
hligne = 15 'à adapter
For n = 1 To Wdoc.Tables.Count
    If Me("CheckBox" & n) Then
        Wdoc.Tables(n).Rows.SetHeight 0.1, 2 'wdRowHeightExactly
        For i = 1 To 6
            Wdoc.Tables(n).Borders(i).LineStyle = 0 'wdLineStyleNone
        Next i
    Else
        Wdoc.Tables(n).Rows.SetHeight hligne, 2 'wdRowHeightExactly
        For i = 1 To 6
            Wdoc.Tables(n).Borders(i).LineStyle = 1 'wdLineStyleSingle
        Next i
    End If
Next n
AppActivate Wapp.Caption 'affiche Word
Unload Me 'ferme l'UserForm
End Sub
Elle masque le tableau Word et ses bordures quand la CheckBox est cochée.

A+
 

Pièces jointes

  • Fichier Excel.xlsm
    25.2 KB · Affichages: 3
  • Doc Word.docx
    13.3 KB · Affichages: 4

job75

XLDnaute Barbatruc
Bonjour le forum,

Si en même temps qu'on masque un tableau on veut masquer son titre on utilisera des signets :
VB:
Private Sub CommandButton1_Click()
Dim Wapp As Object, Wdoc As Object, hligne, n, i
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
On Error GoTo 0
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Doc Word.docx")
hligne = 15 'à adapter
For n = 1 To Wdoc.Tables.Count
    If Me("CheckBox" & n) Then
        Wdoc.Bookmarks("Tableau" & n).Range.Font.Size = 1
        Wdoc.Bookmarks("Tableau" & n).Range.ParagraphFormat.SpaceBefore = 0
        Wdoc.Bookmarks("Tableau" & n).Range.ParagraphFormat.SpaceAfter = 0
        Wdoc.Tables(n).Rows.SetHeight 0.1, 2 'wdRowHeightExactly
        For i = 1 To 6
            Wdoc.Tables(n).Borders(i).LineStyle = 0 'wdLineStyleNone
        Next i
    Else
        Wdoc.Bookmarks("Tableau" & n).Range.Font.Size = 11
        Wdoc.Bookmarks("Tableau" & n).Range.ParagraphFormat.SpaceBefore = 6
        Wdoc.Bookmarks("Tableau" & n).Range.ParagraphFormat.SpaceAfter = 6
        Wdoc.Tables(n).Rows.SetHeight hligne, 2 'wdRowHeightExactly
        For i = 1 To 6
            Wdoc.Tables(n).Borders(i).LineStyle = 1 'wdLineStyleSingle
        Next i
    End If
Next n
AppActivate Wapp.Caption 'affiche Word
Unload Me 'ferme l'UserForm
End Sub
A+
 

Pièces jointes

  • Fichier Excel(1).xlsm
    26.7 KB · Affichages: 6
  • Doc Word.docx
    13.4 KB · Affichages: 4

CBX

XLDnaute Nouveau
Bonjour Job75,

Mille merci pour votre aide, vos 2 solutions fonctionnent parfaitement dans leur contexte. Je conserve cela précieusement.
J'ai des difficultés pour l'adapter à mon projet. Pour faire plus simple, je vous transmets les 2 fichiers de tests.
Pouvez vous m'aider ?
 

Pièces jointes

  • Animaux.xlsm
    44.3 KB · Affichages: 3
  • Chat.docx
    15.9 KB · Affichages: 2

job75

XLDnaute Barbatruc
J'ai eu du mal mais je pense être arrivé à faire ce que vous voulez.

Voyez cette longue macro dans le code de l'UserForm :
VB:
Sub Afficher_Word()
Dim Wapp As Object, Wdoc As Object, hligne, i
On Error Resume Next
Set Wapp = GetObject(, "Word.Application")
If Wapp Is Nothing Then Set Wapp = CreateObject("Word.Application")
On Error GoTo 0
Wapp.Visible = True
Set Wdoc = Wapp.Documents.Open(ThisWorkbook.Path & "\Chat.docx")
hligne = 15 'à adapter

'---1er tableau Word---
If Cbox1 <> "" Then
    With Wdoc.Bookmarks("Animal").Range
        .Text = LCase(Cbox1)
        Wdoc.Bookmarks.Add "Animal", Wdoc.Range(.Start, .Start + Len(Cbox1))
    End With
End If
If CboxFruits <> "" Then
    With Wdoc.Bookmarks("Fruits").Range
        .Text = LCase(CboxFruits)
        Wdoc.Bookmarks.Add "Fruits", Wdoc.Range(.Start, .Start + Len(CboxFruits))
    End With
End If
If TextBox1 <> "" Then
    With Wdoc.Bookmarks("Activite").Range
        .Text = TextBox1
        Wdoc.Bookmarks.Add "Activite", Wdoc.Range(.Start, .Start + Len(TextBox1))
    End With
End If
If CboxFruits = "Pommes" Then
    Wdoc.Tables(1).Rows.SetHeight hligne, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(1).Borders(i).LineStyle = 1 'wdLineStyleSingle
    Next i
Else
    Wdoc.Tables(1).Rows.SetHeight 0.1, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(1).Borders(i).LineStyle = 0 'wdLineStyleNone
    Next i
End If

'---3ème tableau Word---
If Cbox1 <> "" Then
    With Wdoc.Bookmarks("Animal1").Range
        .Text = LCase(Cbox1) & " "
        Wdoc.Bookmarks.Add "Animal1", Wdoc.Range(.Start, .Start + Len(Cbox1) + 1)
    End With
End If
If Cbox2 <> "" Then
    With Wdoc.Bookmarks("Couleur").Range
        .Text = LCase(Cbox2)
        Wdoc.Bookmarks.Add "Couleur", Wdoc.Range(.Start, .Start + Len(Cbox2))
    End With
End If
If Cbox1 = "Chat" And Cbox2 = "Vert clair" Then
    Wdoc.Tables(3).Rows.SetHeight hligne, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(3).Borders(i).LineStyle = 1 'wdLineStyleSingle
    Next i
Else
    Wdoc.Tables(3).Rows.SetHeight 0.1, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(3).Borders(i).LineStyle = 0 'wdLineStyleNone
    Next i
End If

'---4ème tableau Word---
If Cbox1 <> "" Then
    With Wdoc.Bookmarks("Animal2").Range
        .Text = LCase(Cbox1) & " "
        Wdoc.Bookmarks.Add "Animal2", Wdoc.Range(.Start, .Start + Len(Cbox1) + 1)
    End With
End If
If Cbox2 <> "" Then
    With Wdoc.Bookmarks("Couleur1").Range
        .Text = LCase(Cbox2)
        Wdoc.Bookmarks.Add "Couleur1", Wdoc.Range(.Start, .Start + Len(Cbox2))
    End With
End If
If Cbox1 = "Chat" And Cbox2 = "Vert foncé" Then
    Wdoc.Tables(4).Rows.SetHeight hligne, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(4).Borders(i).LineStyle = 1 'wdLineStyleSingle
    Next i
Else
    Wdoc.Tables(4).Rows.SetHeight 0.1, 2 'wdRowHeightExactly
    For i = 1 To 6
        Wdoc.Tables(4).Borders(i).LineStyle = 0 'wdLineStyleNone
    Next i
End If

'---5ème tableau Word---
If Cbox1 <> "" Then
    With Wdoc.Bookmarks("Animal3").Range
        .Text = Cbox1
        Wdoc.Bookmarks.Add "Animal3", Wdoc.Range(.Start, .Start + Len(Cbox1))
    End With
End If

AppActivate Wapp.Caption 'facultatif, affiche Word

End Sub
Elle est appelée par le bouton Ajouter.
 

Pièces jointes

  • Animaux(2).xlsm
    48.6 KB · Affichages: 3
  • Chat.docx
    15.9 KB · Affichages: 3
Dernière édition:

Discussions similaires

Statistiques des forums

Discussions
312 935
Messages
2 093 740
Membres
105 805
dernier inscrit
belgacem.nahali