Good day.
I have a VBA macro that attempts to opens a second excel file, add a button to the second file and assign a macro from the second file called Hyperlink_Execute from Module1 to it.
The problem I am having is that the assignment of the macro ends up being relative to the first file called "Brandon Add hyperLink Loop.xlsm"
The code in question is near the end of the program below starting at the "With bt1"
When I examine the button properties from the second file and check the macro assigned to the button, it turns out to be 'Brandon Add hyperLink Loop.xlsm'!Hyperlink_Execute
Where "Brandon Add hyperLink Loop.xlsm" is the name of the first excel file.
What I want is to assign the button the Hyperlink_Execute macro from the second file.
I think the problem is with the following line
.OnAction = "Hyperlink_Execute"
Somehow I need to reference this to the second file, how do I do that?


Screenshot 2022-07-08 150456.gif


Sub Hyperlinks_Loop_Add()

Dim Location As String
Dim FilePath, FileName, NewName As String
Dim j, Count As Double

ControlFile = ActiveWorkbook.Name

Count = Sheets("Layouts").Cells(Rows.Count, 4).End(xlUp).Row

For j = 2 To Count
FileName = Sheets("Layouts").Cells(j, 1).Value
FilePath = Sheets("Layouts").Cells(j, 4).Value
NewFile = Sheets("Layouts").Cells(j, 5).Value
NewName = Sheets("Layouts").Cells(j, 6).Value

Workbooks.Open FileName:=(FilePath)
Windows(FileName).Activate
Application.DisplayAlerts = False
ActiveWorkbook.SaveAs FileName:=(NewFile), _
FileFormat:=xlOpenXMLWorkbookMacroEnabled
'Kill (FilePath)
Windows(NewName).Activate

With ActiveWorkbook

Location = ActiveCell.Address

Const ModulePath As String = "C:\Users\chris\Documents\AW\Customers\Atlas\VBA Layout\PrintsTube\HyperlinkExecute.bas" 'C:\Users\chris\Documents\AW\Customers\Atlas\VBA Layout\PrintsTube

Dim thisTarget As Workbook
Dim thisName As String

Set thisTarget = ActiveWorkbook
thisName = thisTarget.Name

thisTarget.VBProject.VBComponents.Import ModulePath

Set NewSheet = Sheets.Add
With NewSheet
.Name = "Hyperlink Files"
End With

Sheets("Hyperlink Files").Range("A1").Value = "Print Files"
Sheets("Hyperlink Files").Range("B1").Value = "Setup Sheet Files"
Sheets("Hyperlink Files").Range("A1:B1").Select
Selection.Font.Underline = xlUnderlineStyleSingle
Selection.Font.Bold = True

Dim printfldr As String
Dim setupfldr As String
Dim part As String



printfldr = "C:\Users\chris\Documents\AW\Customers\Atlas\VBA Layout\PrintsTube\Prints" 'C:\Users\chris\Documents\AW\Customers\Atlas\VBA Layout\PrintsTube
setupfldr = "C:\Users\chris\Documents\AW\Customers\Atlas\VBA Layout\PrintsTube\Setup Sheets"

part = Sheets("Layout").Range("C6").Value
If part = "" Then
MsgBox "ENTER PART NUMBER"
Exit Sub
End If

strfile1 = Dir(printfldr & "\" & part & "*")

fc = 1
Do While Len(strfile1) > 0
fc = fc + 1
Sheets("Hyperlink Files").Cells(fc, 1).Value = strfile1
strfile1 = Dir
Loop

strfile2 = Dir(setupfldr & "\" & part & "*")
fc = 1
Do While Len(strfile2) > 0
fc = fc + 1
Sheets("Hyperlink Files").Cells(fc, 2).Value = strfile2
strfile2 = Dir
Loop

Dim AEnd As Long
Dim BEnd As Long
Dim File As String

AEnd = Sheets("Hyperlink Files").Cells(Rows.Count, 1).End(xlUp).Row
BEnd = Sheets("Hyperlink Files").Cells(Rows.Count, 2).End(xlUp).Row

For i = 2 To AEnd
File = Sheets("Hyperlink Files").Cells(i, 1).Value
Sheets("Hyperlink Files").Hyperlinks.Add Anchor:=Sheets("Hyperlink Files").Cells(i, 1), Address:="C:\Users\ss4760\Documents\FILE MOVE TEST FOLDER\PrintsTube\Prints\" + File
Next i

For i = 2 To BEnd
File = Sheets("Hyperlink Files").Cells(i, 2).Value
Sheets("Hyperlink Files").Hyperlinks.Add Anchor:=Sheets("Hyperlink Files").Cells(i, 2), Address:="C:\Users\ss4760\Documents\FILE MOVE TEST FOLDER\PrintsTube\Setup Sheets\" + File
Next i

Sheets("Layout").Unprotect Password:="axila"

Set bt1 = Sheets("Layout").Buttons.Add(600, 296.5, 142, 35.5)

With bt1
.Characters.Text = "Click For Print"
.OnAction = "Hyperlink_Execute"
With .Characters(Start:=1, Length:=15).Font
.Name = "Calibri"
.FontStyle = "Bold"
.Size = 12
.Underline = xlUnderlineStyleSingle
.ColorIndex = 1
End With
End With

Sheets("Hyperlink Files").Visible = False

Sheets("Layout").Range(Location).Select

End With

ActiveWorkbook.Close SaveChanges:=True

Windows(ControlFile).Activate

Next j

End Sub