Problème d'utilisation d'Excel VBA pour ajouter un filigrane à un document Word à l'aide de BuildingBlockEntry

Question

J'essaie actuellement d'utiliser Excel VBA pour ajouter un filigrane à un document Word. J'ai été capable de le faire à partir de Word VBA et j'ai traduit le code sur Excel pour implémenter d'autres fonctions, et j'obtiens une erreur sur une ligne spécifique. Je crois que je dois mieux pointer vers le bloc de construction Word lors de la demande de l'insertion du filigrane, mais je ne suis pas sûr.

L'erreur est "Le membre demandé de la collection n'existe pas" de la ligne: oWord.Templates (strBBPath) .BuildingBlockEntries (strBBName) .Insert Où: = orng, RichText: = True

Voici mon code:

Sub AddWatermark() 
    Dim oWord as Word.Application 
    Dim oDoc As Word.Document 
    Dim oSection As Word.section 
    Dim oHeader As Word.HeaderFooter 
    Dim oRng As Word.Range 
    Dim strName As String 
    Dim strPath As String 
    Dim strBBPath As String 
    Const strBBName As String = "SAMPLE 1" 'The building block name that you want to insert 

    strBBPath = "C:\Users\" & (Environ$("Username")) & "\AppData\Roaming\Microsoft\Document Building Blocks\1033\14\Built-In Building Blocks.dotx" 

       Dim lngCount As Long 

       ' Open the file dialog 
       With Application.FileDialog(msoFileDialogOpen) 
        .AllowMultiSelect = True 
        .Show 

        ' Display paths of each file selected 
        For lngCount = 1 To .SelectedItems.Count 
         Set oWord = New Word.Application 
         strPath = .SelectedItems(lngCount) 
         Set oDoc = oWord.Documents.Open(strPath) 
        Next lngCount 
       End With 

    'oDoc.Save 'save the document 
    strName = oDoc.FullName 'Record the document name 
    oWord.Visible = True 

    'Address each section 
    For Each oSection In oDoc.Sections 
     'Address each header in the section 
     For Each oHeader In oSection.Headers 

      Set oRng = oHeader.Range 
      oRng.Start = oRng.End 'set the range to the end of the header 
      'Insert the built-in building block 
      oWord.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True 

     Next oHeader 
    Next oSection 

    End Sub 

Answer 1

Je trouve une réponse à celle-ci de ce post - https://answers.microsoft.com/en-us/msoffice/forum/msoffice_word-mso_other/run-time-error-5941-not-always-but-annoyingly/b95ec1db-6928-4d87-b799-52d4f1c01f08

Les blocs de construction mots doivent être chargés de tirer d'utiliser cette méthode: oWord.Templates.LoadBuildingBlocks

Merci à tous ceux qui ont un coup d'oeil. :)

Answer 2

Aucune idée pourquoi vous obtenez ce message d'erreur spécifique, sauf si vous avez un identifiant Word égaré quelque part ailleurs dans votre code. Si vous exécutez ceci dans Excel, devrait être "Erreur d'exécution 424 - Objet requis". Vous n'avez pas accès à l'objet Word global dans Excel, donc dans cette ligne ...

Word.Application.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True 

... Excel n'a aucune idée de ce Word est. Option Explicit en haut de votre module aurait attrapé cette erreur. Vous devez utiliser votre objet Word.Application:

oWord.Templates(strBBPath).BuildingBlockEntries(strBBName).Insert Where:=oRng, RichText:=True 

Cela dit, vous êtes évidemment en utilisant la liaison anticipée, déclareraient oWord comme Word.Application ...

Dim oWord As Word.Application 

... et utiliser New au lieu de CreateObject :

Set oWord = New Word.Application