Create worksheet level event in macro

[Ru5ty]

Hello,
I'm fairly new to VBA and need some help since I can't find it anywhere. Here is my situation:
I have a file that is generated automatically every day from another program and exported to a folder. I wrote a macro that opens the file and changes it to make it show data that I need.
My question: Is there a way to make my macro add a worksheet level event (Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)) to some of the sheets my macro has created? There are hyperlinks in my sheets that I want to perform a small macro. I can do this by manually adding the code to the sheets, but I want to be able to have it automatically inserted on those sheets when my first macro is ran.

Thank you in advance!

[mperrah]

If you can use the macro recorder for the steps you want to run,
you can then call that macro from the first script:

sub originalScript()

' original scripts does it's thing then

call recordedMacro

end sub

hope this helps

-mark

[Paul_Hossler]

Probably something like this



Option Explicit

'ref: http://www.cpearson.com/excel/vbe.aspx <<<< VERY highly recommended

Sub DeleteProcedureFromModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim StartLine As Long
Dim NumLines As Long
Dim ProcName As String

Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Sheet1")
Set CodeMod = VBComp.CodeModule

ProcName = "Worksheet_FollowHyperlink"
On Error Resume Next
With CodeMod
StartLine = .ProcStartLine(ProcName, vbext_pk_Proc)
NumLines = .ProcCountLines(ProcName, vbext_pk_Proc)
.DeleteLines StartLine:=StartLine, Count:=NumLines
End With
On Error GoTo 0
End Sub


Sub AddProcedureToModule()
Dim VBProj As VBIDE.VBProject
Dim VBComp As VBIDE.VBComponent
Dim CodeMod As VBIDE.CodeModule
Dim LineNum As Long
Const DQUOTE = """" ' one " character
Set VBProj = ActiveWorkbook.VBProject
Set VBComp = VBProj.VBComponents("Sheet1")
Set CodeMod = VBComp.CodeModule

With CodeMod
LineNum = .CountOfLines + 1
.InsertLines LineNum, "Private Sub Worksheet_FollowHyperlink(ByVal Target As Hyperlink)"
LineNum = LineNum + 1
.InsertLines LineNum, "' Put your code here"
LineNum = LineNum + 1
.InsertLines LineNum, "End Sub"
End With
End Sub

[Ru5ty]

Thanks Mark, but I don't need my original script to call a macro in the script, I need it to insert a worksheet level event in a couple of sheets. I have all the codes I need to perform what I need it to do, the only thing I'm missing is how do I put my Private Sub code into a sheet through my original VBA script. So instead of manually right-clicking on a sheet, clicking view code, and pasting a Private Sub there, I want it to be done automatically through the original script.

[Paul_Hossler]

try my #3

[Ru5ty]

Thank you Paul! This is what I was looking for! Had to do the additional step of enabling VBIDE object library but I'll figure out how to input that reference in the code so other users don't need to go through and checkmark the box. Thanks again Paul!

[Paul_Hossler]

Sorry - I forgot to include the need to add a reference -- It was is the reference URL

This is some code that I had to add a reference programmatically

It works in Win7, Office 2010




Sub AddVBIDE()
MsgBox AddReference("{0002E157-0000-0000-C000-000000000046}")
End Sub



'Macro purpose: To add a reference to the project using the GUID for the reference library
Function AddReference(strGUID As String) As Boolean
Dim theRef As Variant, i As Long


'Set to continue in case of error
On Error Resume Next

'Remove any missing references
For i = ThisWorkbook.VBProject.References.Count To 1 Step -1
Set theRef = ThisWorkbook.VBProject.References.Item(i)
If theRef.isbroken = True Then
ThisWorkbook.VBProject.References.Remove theRef
End If
Next I

'Clear any errors so that error trapping for GUID additions can be evaluated
Err.Clear

'Add the reference
ThisWorkbook.VBProject.References.AddFromGuid GUID:=strGUID, Major:=1, Minor:=0

'If an error was encountered, inform the user
Select Case Err.Number
Case 0
AddReference = True

Case Is = 32813
'Reference already in use. No action necessary
AddReference = True

Case Is = vbNullString
'Reference added without issue
AddReference = True

Case Else
'An unknown error was encountered, so alert the user
MsgBox "A problem was encountered trying to" & vbNewLine _
& "add or remove a reference in this file" & vbNewLine & "Please check the " _
& "references in your VBA project!", vbCritical + vbOKOnly, "Error!"
AddReference = False

End Select

On Error GoTo 0

End Function
'Macro purpose: To determine full path and Globally Unique Identifier (GUID)
'to each referenced library. Select the reference in the Tools\References
'window, then run this code to get the information on the reference's library
Sub ListReferencePaths()
Dim i As Long
Dim r As Range

On Error Resume Next
Call ThisWorkbook.Worksheets("References").Delete
ThisWorkbook.Worksheets.Add.Name = "References"

With ThisWorkbook.Worksheets("References")
.Range("A1") = "Reference name"
.Range("B1") = "Full path to reference"
.Range("C1") = "Reference GUID"
End With

With ThisWorkbook.VBProject
For i = 1 To .References.Count
Set r = ThisWorkbook.Worksheets("References").Rows(i + 1)
r.Cells(1).Value = .References(i).Name
r.Cells(2).Value = .References(i).FullPath
r.Cells(3).Value = .References(i).GUID
Next i
End With

On Error GoTo 0
End Sub

[Ru5ty]

Thanks again Paul! I will set this as a separate macro for others to use only 1 time.

[SamT]

The SheetFollowHyperlink Event occurs when you click any hyperlink in Microsoft Excel.

Private Sub Workbook_SheetFollowHyperlink(ByVal Sh as Object, _
ByVal Target As Hyperlink)
'Sh is the Worksheet that has the Hyperlink.
If Target = "http://www.microsoft.com" then _
Call smallMacro (Sh.Name)
End Sub

Will that work for you. Use Application_SheetFollowHyperlink to watch for the event in another open workbook.

[Paul_Hossler]

Thanks again Paul! I will set this as a separate macro for others to use only 1 time.


Actually, I'd include the



AddReference("{0002E157-0000-0000-C000-000000000046}")


and supporting sub in your main module so that it will add the reference if it needs to transparently to the user

But SamT in #9 has a good idea to consider also: instead of each worksheet having it's own event, only add one in the workbook object