Ceci est une page optimisée pour les mobiles. Cliquez sur ce texte pour afficher la vraie page.

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
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:
Réactions: CBX

Discussions similaires

Les cookies sont requis pour utiliser ce site. Vous devez les accepter pour continuer à utiliser le site. En savoir plus…