C
Charles
Hi I realize that the code below is the solution. But how can I make
this code run everytime I open up excel. I am currently using excel
through lotusscript to print documents out. But on several documents
it gives me this error, so it kills waittime in the lotusscript
program and freezes it untili I press Yes.
How do I implement this code in personal.xls so that whenever I
recieve this error it can perform the following actions?
Thanks,
Charles
Sub ChangeHardcodedSheetName()
'change the VBE 'Actual' name of a sheet to the same as the 'tab'
name
'written by Tom Ogilvy 05/25/2000 in response to a
' question on the Microsoft.public.excel.programming newsgroup
'(You might need to create a reference to
' Microsoft Visual Basic for Applications Extensibility Library
' in Tools References in the VBE) - taken care of in
AddVbideReferenceFromGUID
' line of code
'
' Reference to AddVbideReferenceFromGUID - UDF
' Reference to function CheckForLegalAnsi - UDF
Dim iWkshtCount As Integer, i As Integer
Dim strName As String
Dim wkshtSheet As Worksheet
AddVbideReferenceFromGUID 'Add Reference to Extensibility if not
already available
iWkshtCount = Application.ActiveWorkbook.Worksheets.Count
For i = 1 To iWkshtCount
Set wkshtSheet = Application.Worksheets(i)
strName =
Application.WorksheetFunction.Substitute(wkshtSheet.Name,
" ", "")
strName = Application.WorksheetFunction.Substitute(strName,
"(",
"_")
strName = Application.WorksheetFunction.Substitute(strName,
")",
"_")
wkshtSheet.Parent.VBProject.VBComponents(wkshtSheet.CodeName)
_
.Properties("_CodeName") = CheckForLegalAnsi(strName)
Next i
End Sub
'==============================================
Function CheckForLegalAnsi(strCheckName As String) As String
Dim i As Integer, iTest As Integer, iChecker As Integer
Dim strBuildLegalName As String
If Len(strCheckName) = 0 Then
CheckForLegalAnsi = "Unknown"
Exit Function
End If
strBuildLegalName = ""
'Test for illegal DOS characters in name
For i = 1 To Len(strCheckName)
iTest = 0
iChecker = Asc(Mid(strCheckName, i, 1))
If iChecker >= 48 Then
If iChecker <= 57 Then
iTest = 1
Else
If iChecker >= 65 Then
If iChecker <= 90 Then
iTest = 1
Else
If iChecker = 95 Then
iTest = 1
Else
If iChecker >= 97 Then
If iChecker <= 122 Then
iTest = 1
End If
End If
End If
End If
End If
End If
End If
If iTest = 0 Then
If i = 1 Then
strBuildLegalName = strBuildLegalName & "a_"
Else
strBuildLegalName = strBuildLegalName & "_"
End If
Else
strBuildLegalName = strBuildLegalName & Mid(strCheckName,
i, 1)
End If
Next i
CheckForLegalAnsi = strBuildLegalName
End Function
'==================================================
Sub AddVbideReferenceFromGUID()
'Add Microsoft Visual Basic for Applications Extensibility reference
' VBIDE
' normally at C:\PROGRAM FILES\COMMON FILES\MICROSOFT
SHARED\VBA\VBEEXT1.OLB
'
On Error GoTo Err_AddVbideReference
Dim VarAddReference
Dim refReference
Dim iErrorCounter As Integer
'MsgBox "GUID is: " &
ThisWorkbook.VBProject.References("VBIDE").GUID
iErrorCounter = 0
VarAddReference = _
ActiveWorkbook.VBProject.References.AddFromGuid("{0002E157-0000-0000-
C000-00
0000000046}", 5, 0)
Exit_AddVbideReference:
Exit Sub
Err_AddVbideReference:
iErrorCounter = iErrorCounter + 1
If Err = 32813 Then ' if Reference already active, ignore error
and
exit
Resume Exit_AddVbideReference
End If
If iErrorCounter > 4 Then
Resume Exit_AddVbideReference
End If
If Err = 438 Then ' Object doesn't support this property or method
' This error is often gotten first time thru a
add
reference routine
AddVbideReferenceFromGUID
Exit Sub
End If
MsgBox "Error: " & Err & " - " & Err.Description
Resume Exit_AddVbideReference
End Sub
'==================================================
this code run everytime I open up excel. I am currently using excel
through lotusscript to print documents out. But on several documents
it gives me this error, so it kills waittime in the lotusscript
program and freezes it untili I press Yes.
How do I implement this code in personal.xls so that whenever I
recieve this error it can perform the following actions?
Thanks,
Charles
Sub ChangeHardcodedSheetName()
'change the VBE 'Actual' name of a sheet to the same as the 'tab'
name
'written by Tom Ogilvy 05/25/2000 in response to a
' question on the Microsoft.public.excel.programming newsgroup
'(You might need to create a reference to
' Microsoft Visual Basic for Applications Extensibility Library
' in Tools References in the VBE) - taken care of in
AddVbideReferenceFromGUID
' line of code
'
' Reference to AddVbideReferenceFromGUID - UDF
' Reference to function CheckForLegalAnsi - UDF
Dim iWkshtCount As Integer, i As Integer
Dim strName As String
Dim wkshtSheet As Worksheet
AddVbideReferenceFromGUID 'Add Reference to Extensibility if not
already available
iWkshtCount = Application.ActiveWorkbook.Worksheets.Count
For i = 1 To iWkshtCount
Set wkshtSheet = Application.Worksheets(i)
strName =
Application.WorksheetFunction.Substitute(wkshtSheet.Name,
" ", "")
strName = Application.WorksheetFunction.Substitute(strName,
"(",
"_")
strName = Application.WorksheetFunction.Substitute(strName,
")",
"_")
wkshtSheet.Parent.VBProject.VBComponents(wkshtSheet.CodeName)
_
.Properties("_CodeName") = CheckForLegalAnsi(strName)
Next i
End Sub
'==============================================
Function CheckForLegalAnsi(strCheckName As String) As String
Dim i As Integer, iTest As Integer, iChecker As Integer
Dim strBuildLegalName As String
If Len(strCheckName) = 0 Then
CheckForLegalAnsi = "Unknown"
Exit Function
End If
strBuildLegalName = ""
'Test for illegal DOS characters in name
For i = 1 To Len(strCheckName)
iTest = 0
iChecker = Asc(Mid(strCheckName, i, 1))
If iChecker >= 48 Then
If iChecker <= 57 Then
iTest = 1
Else
If iChecker >= 65 Then
If iChecker <= 90 Then
iTest = 1
Else
If iChecker = 95 Then
iTest = 1
Else
If iChecker >= 97 Then
If iChecker <= 122 Then
iTest = 1
End If
End If
End If
End If
End If
End If
End If
If iTest = 0 Then
If i = 1 Then
strBuildLegalName = strBuildLegalName & "a_"
Else
strBuildLegalName = strBuildLegalName & "_"
End If
Else
strBuildLegalName = strBuildLegalName & Mid(strCheckName,
i, 1)
End If
Next i
CheckForLegalAnsi = strBuildLegalName
End Function
'==================================================
Sub AddVbideReferenceFromGUID()
'Add Microsoft Visual Basic for Applications Extensibility reference
' VBIDE
' normally at C:\PROGRAM FILES\COMMON FILES\MICROSOFT
SHARED\VBA\VBEEXT1.OLB
'
On Error GoTo Err_AddVbideReference
Dim VarAddReference
Dim refReference
Dim iErrorCounter As Integer
'MsgBox "GUID is: " &
ThisWorkbook.VBProject.References("VBIDE").GUID
iErrorCounter = 0
VarAddReference = _
ActiveWorkbook.VBProject.References.AddFromGuid("{0002E157-0000-0000-
C000-00
0000000046}", 5, 0)
Exit_AddVbideReference:
Exit Sub
Err_AddVbideReference:
iErrorCounter = iErrorCounter + 1
If Err = 32813 Then ' if Reference already active, ignore error
and
exit
Resume Exit_AddVbideReference
End If
If iErrorCounter > 4 Then
Resume Exit_AddVbideReference
End If
If Err = 438 Then ' Object doesn't support this property or method
' This error is often gotten first time thru a
add
reference routine
AddVbideReferenceFromGUID
Exit Sub
End If
MsgBox "Error: " & Err & " - " & Err.Description
Resume Exit_AddVbideReference
End Sub
'==================================================