Consulting

Results 1 to 3 of 3

Thread: Word Add-In stops with hyperlink (Word 2013)

  1. #1

    Unhappy Word Add-In stops with hyperlink (Word 2013)

    I finally figured out how to get the code below to run as an add-in, but now I have ran into another issue. I have created an Excel hyperlink interface that links to all the documents that the Engineers use. The documents are both Word and Excel. When I hyperlink to the Word documents, the BeforeSave event that is the Add-in doesn't work. But when I open the Word document directly the Add-in works fine. If I hyperlink to the Word document FROM a Word document then the Add-in works. It only seems to stop working when opening from the Excel hyperlink. I even made sure to turn of the excel BeforeSave add-in and place a hyperlink in a workbook free of any macros, but the Word Add-in still didn't work.
    I'm assuming that because it is opened from Excel that the event is not seeing Word being opened? But I'm not sure what I am missing.

    Here is my code:

    This Document:
    Private Sub Document_New()
    Register_Event_Handler
    End Sub
    Private Sub Document_Open()
    Register_Event_Handler
    End Sub
    Module (mdlEventConnect):
    Dim EventHandler As New clsEventHandler
    Public Sub Register_Event_Handler()
     Set EventHandler.App = Word.Application
    End Sub
    Public Sub AutoExec()
     Set EventHandler.App = Word.Application
    End Sub
    Class Module (clsEventHandler):
    Public WithEvents App As Word.Application
    Private Sub App_DocumentBeforeSave(ByVal Doc As Document, SaveAsUI As Boolean, Cancel As Boolean)
    If SaveAsUI Then
    GoTo lbl_End
    Else
        Dim myForm As frmSaveMethod
        Dim i As Long, bAdd As Boolean: bAdd = True
        Dim sTab As String
        Dim oSection As Section
        Dim oHF As HeaderFooter
        Dim myName As String
        Dim ext As String
        Dim myPath As String
        Dim T As String
        Dim fso As Object
        myName = Left(ActiveDocument.Name, (InStrRev(ActiveDocument.Name, ".") - 1))
        ext = Right(ActiveDocument.Name, Len(ActiveDocument.Name) - InStrRev(ActiveDocument.Name, "."))
        myPath = ActiveDocument.Path & "\"
        T = Format(Now, "DDMMMyy")
    'On Error GoTo lbl_Error
        'SAVE & UPDATE MESSAGE BOX
        Set myForm = New frmSaveMethod
            myForm.Show
        Select Case myForm.Tag
        Case 1
            'FOOTER SECTION
            With ActiveDocument.Sections.First.Footers(wdHeaderFooterPrimary).Range
                For i = 1 To .Fields.Count
                    If .Fields(i).Type = wdFieldPage Then
                        bAdd = False: Exit For
                    End If
                Next
                sTab = vbTab & "                                                "
                If bAdd = True Then
                    .Fields.Add .Characters.Last, wdFieldEmpty, "FILENAME", False
                    .InsertAfter "_"
                    .Fields.Add .Characters.Last, wdFieldEmpty, "DATE \@ ""DDMMMyy""", False
                    .InsertAfter sTab
                    .Fields.Add .Characters.Last, wdFieldEmpty, "PAGE", False
                    .InsertAfter " of "
                    .Fields.Add .Characters.Last, wdFieldEmpty, "NUMPAGES", False
            
                End If
            End With
            For Each oSection In ActiveDocument.Sections
                For Each oHF In oSection.Footers
                    oHF.Range.Font.Size = 8
                Next
            Next
            '-SAVE & BACKUP SECTION-
            If ActiveDocument.Path = "" Then GoTo lbl_Exit
            'SAVE AS PDF
            ActiveDocument.ExportAsFixedFormat _
            OutputFileName:=myPath & myName & ".pdf", _
            ExportFormat:=wdExportFormatPDF, OpenAfterExport:=True
            'SAVE IN ARCHIVE FOLDER
            Set fso = CreateObject("Scripting.FileSystemObject")
            If Not fso.FolderExists(ActiveDocument.Path & "\Archive") Then
                fso.CreateFolder (ActiveDocument.Path & "\Archive")
            End If
            fso.CopyFile ActiveDocument.FullName, ActiveDocument.Path & "\Archive\" & myName & "_" & T & "." & ext
            
            ActiveDocument.Save
            
        Case 2
            'MORMAL SAVE - NO MACRO
            ActiveDocument.Save
        
        Case 3
            'CANCEL BUTTON
            Cancel = True
        End Select
            Unload myForm
            Set myForm = Nothing
    lbl_Exit:
            Set fso = Nothing
    End If
    lbl_End:
    Exit Sub
    lbl_Error:
        MsgBox "The following error occurred: " & Err.Description
        Unload myForm
        Set myForm = Nothing
        
    End Sub
    Thanks again for the help. - David

  2. #2
    Because of the way Word is opened from a Hyperlink, the autoexec macro in the add-in doesn't run when you click the Hyperlink. A solution you could consider is to make the workbook with the links macro enabled and add a macro event to its ThisWorkbook module to ensure Word is started and the event in your add-in activated when the hyperlink is clicked . e.g. as follows

    To prevent false triggering you could limit the Target.Range to the range that contains your hyperlinks.

    Option Explicit
    
    Private Sub Workbook_SheetFollowHyperlink(ByVal Sh As Object, ByVal Target As Hyperlink)
    Dim wdApp As Object
    Dim wdDoc As Object
        On Error Resume Next
        Set wdApp = GetObject(, "Word.Application")
        If Err Then
            Set wdApp = CreateObject("Word.Application")
        End If
        On Error GoTo 0
        wdApp.Visible = True
        wdApp.Run "Register_Event_Handler"
    End Sub
    the Hyperlink should then load the document in the running Word application.

    Your Word module code should be
    Option Explicit
    Public EventHandler As New clsEventHandler
    
    Public Sub Register_Event_Handler()
        Set EventHandler.App = Word.Application
    End Sub
    
    Public Sub AutoExec()
        Register_Event_Handler
    End Sub
    and the macros in the ThisDocument module are superfluous
    Graham Mayor - MS MVP (Word) 2002-2019
    Visit my web site for more programming tips and ready made processes
    http://www.gmayor.com

  3. #3
    Thank you very much Graham. So this works perfect with a normal hyperlink, but today I was asked to make the sheets look more "visually appealing". I started to create rounded rectangle shapes to put the hyperlink into to give the appearance of a button. For some reason, placing the hyperlink in a shape is not letting the add-in run again. Sometimes I feel like I can never win.

    Also, the only reason I had the DocumentOpen() and DocumentNew() in ThisDocument was to test the event before I created the template. The AutoExec() doesn't seem to work until it is ran as an add-in.

Tags for this Thread

Posting Permissions

  • You may not post new threads
  • You may not post replies
  • You may not post attachments
  • You may not edit your posts
  •