View Full Version : Create worksheet level event in macro
Ru5ty
05-18-2015, 11:44 AM
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
05-18-2015, 12:45 PM
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
05-18-2015, 01:39 PM
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
05-18-2015, 01:41 PM
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
05-18-2015, 01:57 PM
try my #3
Ru5ty
05-18-2015, 02:24 PM
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
05-18-2015, 02:35 PM
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
05-18-2015, 03:00 PM
Thanks again Paul! I will set this as a separate macro for others to use only 1 time.
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
05-18-2015, 04:44 PM
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
Powered by vBulletin® Version 4.2.5 Copyright © 2024 vBulletin Solutions Inc. All rights reserved.