Search code examples
excelvbams-wordqr-code

How to create an EmptyField in MS Word from MS Excel using VBA


I need to insert in one excel report a QR code in which the source data is also on this excel. Due the policies of my company, I cannot use any external link or application, so Google Charts, QR code API and etc are not an option... My idea is, from the excel report make a call creating a MS Word document, add a field and using the {DISPLAYBARCODE...} controlled field, generate my QR code, returning as a picture to my Excel report. Right after the MS Word will be close without saving.

I am not a VBA master and I don't know my code is not working. I can create an open the MS Word file, paste a simple text but I can't create the field, always have the error 450 message.

Sub CopyToWord()

Dim doc As Object 'Word.Document

    Set doc = CreateObject("Word.Document") 'New Word.Document
    doc.Application.Visible = False 'Leave the Word document visible
    
        With doc.ActiveWindow.Selection
            doc.Fields.Add Range:=Selection.Range, Type:=wdFieldEmpty, Text:="DISPLAYBARCODE xxx", PreserveFormatting:=True
            .Fields.ToggleShowCodes
           
        End With
      
      doc.Application.Activate
End Sub

Solution

  • When working across Office applications it is vital to qualify every object properly. For example: Selection.Range could refer to either Word or Excel. As the code is being run from Excel an unqualified reference to Selection will be interpreted as meaning Excel.Selection.

    As Selection is a child of Application you also need to include an application object in your code.

    Public Function GetWordApp(wdApp As Object) As Boolean
    
        On Error Resume Next
        GetWordApp = False
        Set wdApp = GetObject(, "Word.Application")
        If Err > 0 Or wdApp Is Nothing Then
            'Word not yet open
            Err.Clear
            Set wdApp = CreateObject("Word.Application")
            If Err = 0 Then GetWordApp = True
        Else
            GetWordApp = True
        End If
        On Error GoTo 0
    
    End Function
    
    Sub CopyToWord()
    
        Dim wdApp As Word.Application, doc As Word.Document, fld As Word.Field
        
        If GetWordApp(wdApp) Then
            Set doc = wdApp.Documents.Add
            'use this if you want to do something else with the field
            Set fld = doc.Fields.Add(Range:=wdApp.Selection.Range, Type:=wdFieldEmpty, Text:="DISPLAYBARCODE xxx", PreserveFormatting:=True)
            fld.ShowCodes = True
            'alternative method
            'doc.Fields.Add Range:=wdApp.Selection.Range, Type:=wdFieldEmpty, Text:="DISPLAYBARCODE xxx", PreserveFormatting:=True
            'doc.Range.Fields.ToggleShowCodes
            wdApp.Visible = True
            wdApp.Activate
        End If
    End Sub