Add-In Problem Disables Excel

[DaveB]

I created an add-in that is having problems. I have used this Add-in
on my machine and installed it on various other users with-out any
undue problems. Today, when I installed it on another users computer,
when he first opened the Add-In everything went fine. Later after
exiting Excel and then opening Excel again, the problem occured.
Excel did not open an empty workbook as usual, and nothing happened
when clicking on the menu or tool bars. The only thing that wouold
work was to close Excel by clicking on the x box in the upper right
hand corner. We tried it several times with the same result. I have
never experienced this problem with Excel before. I have used this
Addin with Excel 97, 2000 , and XP. Our computers are running Windows
2000. I thought it might have something to do with the Add-In
workbook code which is copied below:

Any ideas would be appreciated.

Option Explicit

Dim WithEvents App As Application

Private Sub Workbook_Open()
Dim wb As Workbook
For Each wb In Workbooks
TestLink wb
Next wb
Set App = Application
AddFunctionsToNewCategory
End Sub

Private Sub App_WorkbookOpen(ByVal wb As Excel.Workbook)
TestLink wb
End Sub

Private Sub TestLink(wb As Workbook)
Dim Link As Variant
Dim I As Integer

If IsEmpty(wb.LinkSources(xlExcelLinks)) Then Exit Sub
For Each Link In wb.LinkSources(xlExcelLinks)
If Link = Me.FullName Then Exit Sub
For I = Len(Link) To 1 Step -1
If Mid$(Link, I, 1) = "\" Then Exit For
Next I
If Mid$(Link, I + 1) = Me.Name Then
wb.ChangeLink Link, Me.FullName, xlLinkTypeExcelLinks
Application.VBE.ActiveVBProject.References.AddFromFile
Me.FullName
Exit Sub
End If
Next Link
End Sub

This code I borrowed and is in a separate module:

Sub AddFunctionsToNewCategory()

Const CatName = "Sim Functions" 'the desired name of the new category
Const NbFuncs = 1 'number of functions to be added to above
category
Dim I As Integer
Dim Cat As String 'function category string name
Dim LCat As Integer 'function category index
Dim FctName, FctDesc 'name and description of user-defined functions

' sets up the names and descriptions for the new functions
FctName = Array("GetSimVals")
FctDesc = Array("Retrieves value(s) from Simulator")

Application.ScreenUpdating = False

' tells workbook that it is not an addin
ThisWorkbook.IsAddin = False

' starts the looping with function category 14, which is "User
Defined"
LCat = 14

' increments by one
Do
LCat = LCat + 1

' inserts a dummy name "Djzh15" into macro sheet, sets it zero,
defines it
' as Command Macro (so the function category can be specified), does
not provide
' shortcut key, does not define name as Hidden, and sets the category
index to
' the current value of the loop variable

Application.ExecuteExcel4Macro "DEFINE.NAME(""Djzh" & LCat &
""",0,2,,," & LCat & ")"

' returns the function category name for the newly defined name above
Cat = Names("Djzh" & LCat).Category

' continues to loop, incrementing category index until returned
category name is
' either "User Defined" or the function category name set in constant
block -
' If the name returned is same as that in constant, then category
already exists
' and the index for that function category is the current loop
variable.
' If name returned is "User Defined", this means there is no Current
Category
' with established name (it is unallocated) and this index is the next
Number
' in the sequence that would be assigned to a new function category
asthe name

Loop While Cat <> "User Defined" And Cat <> CatName

' If name "Sim Functions" doesn't, exist (because of returned "User
Defined ""
' name from the above loop) then define a dummy name and at same time,
create
' the new function category "Sim Functions" to replace the "User
Defined" name
' If name exists, then don't need to create function category, it
already exists

If Cat = "User Defined" Then
Application.ExecuteExcel4Macro "DEFINE.NAME(""Djzh" & LCat &
""",0,2,,,""" & CatName & """)"
End If

' put the desired user defined functions function Category
For I = 0 To NbFuncs - 1
Application.MacroOptions Macro:=FctName(I),
Description:=FctDesc(I), Category:=LCat, HelpFile:="SimLink.chm"
Next I

' delete all of the dummy names
For I = 15 To LCat
Application.ExecuteExcel4Macro "DELETE.NAME(""Djzh" & I &
""")"
Next I

' tell thenworkbook that it is an Addin
ThisWorkbook.IsAddin = True
ThisWorkbook.Saved = True

End Sub