Make hyperlink a cell content and create a link to a create

[chamdan]

Hi Hans or Rudi,

I need your help in achieving the following:
I have an Excel workbook that contains a worksheet named "Change-Log" and in column "C" starting from Row 6 are integrated Change request. In Column "C" each time a change Request number is generated automatically based on the Group selection in column "B" then a new serial number is concatenated to the group name as shown below in the example:
Col (B) Col (C) Col (D)
Group name Change Request # Change Request description
EPPA EPPA-CHR-001 Change xxxxxxxxxxxxxxxxxxx
EPPA EPPA-CHR-002 Change yyyyyyyyyyyyyyyyyyyy

The Change Request macro that generates the Change Request # works fine and the serial number works fine as well but what I wish to do is once the change Request # is generated e.g EPPA-CHR-001 for instance it will create a word document based on a template call Change Request and will save it as Change Request EPPA-CHR-001 in the same folder as the active workbook path and create a hyperlink in the cell that contains the Change Request #, here EPPA-CHR-001 located in the Cell (C6) pointing to the Word Change Request document. So user can access straight forward the document when clicking on the corresponding cell containing the corresponding Change Request #.

Hope My question is clear?

Looking forward to hearing from you.

Regards,

Chuck

[Rudi]

Hi Chuck,

Here is a starting point for you.

The code will respond to the activecell (selected cell). I guess that eventually the macro can be integrated into a Worksheet_Calculate event or something that it triggers when the Change Request # is calculated. For now it is a stand alone macro that responds to the activecell when you run the macro.
The code below creates a new Word doc based on a template from this line: WdObj.Documents.Open Filename:="C:\Change Request.dotx"
You can change the path to the actual template.
Then it converts the activecell into a hyperlink that points to the document created.

Test it out and see if you can use it.
When Hans jumps in, he may provide something more optimal or have further suggestions.

Cheers

Code: Select all

Sub Chamdan()
Dim WdObj As Object, fName As String, sPath As String
    fName = ActiveCell.Value
    Set WdObj = CreateObject("Word.Application")
    WdObj.Visible = False
    WdObj.Documents.Open Filename:="C:\Change Request.dotx"
    If fName <> "" Then
        With WdObj
            sPath = ThisWorkbook.Path
            .ActiveDocument.SaveAs Filename:=sPath & "\" & "Change Request " & fName & ".doc"
        End With
    Else
        MsgBox "File not saved, naming range was errored.",vbExclamation
    End If
    With WdObj
        .ActiveDocument.Close
        .Quit
    End With
    ActiveSheet.Hyperlinks.Add Anchor:=Selection, Address:=sPath & "\" & "Change Request " & fName & ".doc" _
        , TextToDisplay:=ActiveCell.Value
    Range("A1").Select
    Set WdObj = Nothing
End Sub

[HansV]

Here is a slightly modified version of Rudi's macro.

It doesn't try to start Word if the active cell is empty.
It creates a new document from the template instead of opening the template itself.
It looks for the template in the user templates folder. If it is stored elsewhere, simply modify the path, as in Rudi's version.
It saves the document as a .docx instead of a .doc since the template is .dotx.

Code: Select all

Sub CreateDocAndHyperlink()
    Dim wdApp As Object
    Dim wdDoc As Object
    Dim fName As String
    Dim sPath As String
    Dim sFullName As String
    fName = ActiveCell.Value
    If fName = "" Then
        MsgBox "No filename supplied", vbExclamation
        Exit Sub
    End If
    Set wdApp = CreateObject("Word.Application")
    Set wdDoc = wdApp.Documents.Add(Template:=wdApp.Application.Options.DefaultFilePath(2) & _
        "\Change Request.dotx")
    sPath = ThisWorkbook.Path
    sFullName = sPath & "\Change Request " & fName & ".docx"
    wdDoc.SaveAs Filename:=sFullName, FileFormat:=12
    wdDoc.Close SaveChanges:=False
    Set wdDoc = Nothing
    wdApp.Quit SaveChanges:=False
    Set wdApp = Nothing
    ActiveSheet.Hyperlinks.Add Anchor:=ActiveCell, Address:=sFullName, _
        TextToDisplay:=fName
End Sub

[Rudi]

Yep...as I expected. Much cleaner.
I really find it educational to compare my code to yours and see where I can learn and improve.
Cheers!

[chamdan]

Thank you both for your prompt reply. I tried both and Rudi's one worked but Hans' gave me an error 5151 on the line:

Code: Select all

 Set wdDoc = wdApp.Documents.Add(Template:=wdApp.Application.Options.DefaultFilePath(2) & _
        "\Change Request.dotx")

I guess it's because of the DefaultFilePath(2), which I think it is where normally the templates are located. Is'nt it? If so is it possible to use the ActiveWorkbook.Path as the DefaultPath?

Regards,

Chuck

[HansV]

If your template resides in the same folder as the workbook, you can change

Code: Select all

    Set wdDoc = wdApp.Documents.Add(Template:=wdApp.Application.Options.DefaultFilePath(2) & _
        "\Change Request.dotx")
    sPath = ThisWorkbook.Path

to

Code: Select all

    sPath = ThisWorkbook.Path
    Set wdDoc = wdApp.Documents.Add(Template:=sPath & "\Change Request.dotx")

[chamdan]

Hans.

It worked. So I was right about the location of template. I am learning from both of you and I really appreciate you help.



Chuck