PDA

View Full Version : [SOLVED] Run-time error '445' - Object doesn't support this activity



sollijones
05-10-2016, 12:11 PM
Hello Community,

We are experiencing an issue with a delivered PeopleSoft nVision StyleSheets macro that was probably carried over from Excel 2003 or earlier. Our nVision environment is now using Excel 2007. However, many users have Excel 2010 or 2016 installed on their computers.

The StyleSheeets macro is used to format PS nVision layouts (an Excel file). The StyleSheets templates are saved under a specific directory that is identified in the configuration for nVision in the PeopleSoft Application Designer program.

I have a very limited understanding of VBA and would greatly appreciate some guidance.

The run-time error 445 is first generated when the macro to Open Style Sheets is selected. When debug is selected, the "Unload StyleTypes" line is highlighted -
Activates the Style Sheet creation wizard

Sub OpenStyleSheets()
Unload StyleTypes
StyleTypes.Show
End Sub

After additional research, it was discovered that FileSearch is usually the cause of this run-time error. When the code was searched for FileSearch, the following code was found -


' Retrieves all valid Style sheets.
Sub GetStyleTypes()
Dim Dirlen As Integer
Dim f, f1, fc, s
Dim iFileCount As Integer
Dim strTemp As String
iFileCount = 0
GetDirectory
Set fs = Application.FileSearch
With fs
.LookIn = Directory
.FileType = msoFileTypeExcelWorkbooks
If .Execute > 0 Then
iFileCount = .FoundFiles.Count
For i = 1 To iFileCount
Dirlen = Len(.LookIn) + 2
strTemp = Mid(.FoundFiles(i), Dirlen)
StyleBox.AddItem (strTemp)
Next i
End If
End With
If iFileCount = 0 Then
Set fs = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Directory)
Set fc = f.Files
For Each f1 In fc
If UCase(Right((f1.Name), 4)) = ".XLS" Then
iFileCount = iFileCount + 1
Dirlen = Len(Directory) + 2
strTemp = f1.Name
StyleBox.AddItem (strTemp)
End If
Next
End If
cleanup:
Set fs = Nothing
Set f = Nothing
Set fc = Nothing
End Sub

Leith Ross
05-10-2016, 02:44 PM
Hello sollijones,

The VBA statement Unload is used to remove a VBA UserForm from memory. If the UserForm does not exist in memory then an error is thrown. You can easily remedy the situation by trapping and ignoring the error like this...



Sub OpenStyleSheets()
On Error Resume Next
Unload StyleTypes
On Error Goto 0
StyleTypes.Show
End Sub

sollijones
05-11-2016, 06:52 AM
Thank you so much for your response, Leith.

I updated the code based on your suggestion and now it errors on the StyleTypes.Show line.



Hello sollijones,

The VBA statement Unload is used to remove a VBA UserForm from memory. If the UserForm does not exist in memory then an error is thrown. You can easily remedy the situation by trapping and ignoring the error like this...



Sub OpenStyleSheets()
On Error Resume Next
Unload StyleTypes
On Error Goto 0
StyleTypes.Show
End Sub

GTO
05-11-2016, 07:04 AM
I am probably just being goofy. If you highlight StyleTypes, right-click and select Definition, what happens?

sollijones
05-11-2016, 07:13 AM
GTO, I received the following message:
"Cannot jump to 'Show' because it is hidden."


I am probably just being goofy. If you highlight StyleTypes, right-click and select Definition, what happens?

GTO
05-11-2016, 08:35 AM
Did the Object Browser Window pop-up? Right-click in the Members pane and select "Show Hidden Members". Now try it.

sollijones
05-11-2016, 08:52 AM
GTO, the Object Browser Window did pop-up and I selected "Show Hidden Members". When I attempted to run the macro again, I received the following message:
"Cannot jump to 'Show' because it is in the library 'Unknown7' which is not currently referenced". Please see the attached screenshot.

Regards,
SOJ


Did the Object Browser Window pop-up? Right-click in the Members pane and select "Show Hidden Members". Now try it.

GTO
05-11-2016, 08:56 AM
Okay, thank you for testing. I do not think it (StyleTypes) is a userform. I am logging out shortly, but would it be possible to upload the workbook with the code in it? Scrub any sensitive data of course...

sollijones
05-11-2016, 09:09 AM
GTO, thank you so much for assisting me with this. It seems that the 'Show' object should be moved to another library - either the one for the specific workbook (nvsuser.xls) or perhaps under MSForms. Please see the attached workbook.

Best regards,
SOJ


Okay, thank you for testing. I do not think it (StyleTypes) is a userform. I am logging out shortly, but would it be possible to upload the workbook with the code in it? Scrub any sensitive data of course...

SamT
05-11-2016, 09:58 AM
"Show" is not an object, it is a method. This is what the first sub in your first post is saying

Sub OpenStyleSheets()
Unload UserForms("StyleTypes")
UserForms("StyleTypes").Show
End Sub

GTO
05-13-2016, 04:16 AM
Okay, thank you for testing. I do not think it (StyleTypes) is a userform. I am logging out shortly, but would it be possible to upload the workbook with the code in it? Scrub any sensitive data of course...

ACK! I was wrong; it is a userform. See below...


Hello Community,

We are experiencing an issue with a delivered PeopleSoft nVision StyleSheets macro that was probably carried over from Excel 2003 or earlier. Our nVision environment is now using Excel 2007. However, many users have Excel 2010 or 2016 installed on their computers.

The StyleSheeets macro is used to format PS nVision layouts (an Excel file). The StyleSheets templates are saved under a specific directory that is identified in the configuration for nVision in the PeopleSoft Application Designer program.

I have a very limited understanding of VBA and would greatly appreciate some guidance.

The run-time error 445 is first generated when the macro to Open Style Sheets is selected. When debug is selected, the "Unload StyleTypes" line is highlighted -
Activates the Style Sheet creation wizard
...

After additional research, it was discovered that FileSearch is usually the cause of this run-time error. When the code was searched for FileSearch, the following code was found


Although it appears expired, I did note this in the workbook: '* Copyright (c) 1988-1999 PeopleSoft, Inc. All Rights Reserved. *

You mention that you are now using Excel2007, with some using newer versions than this. I believe that FileSearch was depreciated (a fancy way of saying it no longer works) in 2007 and thereafter. I would contact the vendor or PeopleSoft for a newer version of this workbook. I would be confident that they have long since updated the workbook to use another method.

Sorry for missing what you clearly stated in your first post...

Mark

sollijones
05-13-2016, 05:59 AM
Thank you for taking the time to look into this. Yes, I was informed that FileSearch no longer worked in 2007. However, since the code didn't error on that I wasn't convinced that that was the root of the problem. Unfortunately, we are no longer under Oracle support. I've been researching how to update the FileSearch code to be applicable to newer versions of Excel.

Best regards,
SOJ


ACK! I was wrong; it is a userform. See below...



Although it appears expired, I did note this in the workbook: '* Copyright (c) 1988-1999 PeopleSoft, Inc. All Rights Reserved. *

You mention that you are now using Excel2007, with some using newer versions than this. I believe that FileSearch was depreciated (a fancy way of saying it no longer works) in 2007 and thereafter. I would contact the vendor or PeopleSoft for a newer version of this workbook. I would be confident that they have long since updated the workbook to use another method.

Sorry for missing what you clearly stated in your first post...

Mark

snb
05-13-2016, 07:21 AM
This will solve your problem:


Sub GetStyleTypes()
Dim Dirlen As Integer
Dim f, f1, fc, s
Dim iFileCount As Integer
Dim strTemp As String
iFileCount = 0
GetDirectory
' Set fs = Application.FileSearch
' With fs
' .LookIn = Directory
' .FileType = msoFileTypeExcelWorkbooks
' If .Execute > 0 Then
' iFileCount = .FoundFiles.Count
' For i = 1 To iFileCount
' Dirlen = Len(.LookIn) + 2
' strTemp = Mid(.FoundFiles(i), Dirlen)
' StyleBox.AddItem (strTemp)
' Next i
' End If
' End With
' If iFileCount = 0 Then
' Set fs = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Directory)
Set fc = f.Files
For Each f1 In fc
If UCase(Right((f1.Name), 4)) = ".XLS" Then
iFileCount = iFileCount + 1
Dirlen = Len(Directory) + 2
strTemp = f1.Name
StyleBox.AddItem (strTemp)
End If
Next
' End If
cleanup:
Set fs = Nothing
Set f = Nothing
Set fc = Nothing
End Sub

sollijones
05-13-2016, 11:23 AM
Thank you so much, snb!


I am no longer getting a run-time error and the macro is invoking the drop-down menu that will allow the user to select one of the style sheet files in the directory. I also commented out the Unload UserForms line. I kept receiving another run-time error, 438 "Object doesn't support this property or method".


Sub OpenStyleSheets()
‘Unload UserForms.StyleTypes
StyleTypes.Show
End Sub


I also added the StyleTypes.Show line. I believe the previous code had UserForms.Show because the style sheets were not being displayed in the drop-down.


Private Sub UserForm_Initialize()
GetStyleTypes
StyleTypes.Show
End Sub


I am not experiencing an issue with closing the user form (style sheet) after one has been selected. I am researching the code for the UserForms.Hide line.

I've attached a couple of screenshots for reference.


Best regards,
SOJ


This will solve your problem:


Sub GetStyleTypes()
Dim Dirlen As Integer
Dim f, f1, fc, s
Dim iFileCount As Integer
Dim strTemp As String
iFileCount = 0
GetDirectory
' Set fs = Application.FileSearch
' With fs
' .LookIn = Directory
' .FileType = msoFileTypeExcelWorkbooks
' If .Execute > 0 Then
' iFileCount = .FoundFiles.Count
' For i = 1 To iFileCount
' Dirlen = Len(.LookIn) + 2
' strTemp = Mid(.FoundFiles(i), Dirlen)
' StyleBox.AddItem (strTemp)
' Next i
' End If
' End With
' If iFileCount = 0 Then
' Set fs = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.GetFolder(Directory)
Set fc = f.Files
For Each f1 In fc
If UCase(Right((f1.Name), 4)) = ".XLS" Then
iFileCount = iFileCount + 1
Dirlen = Len(Directory) + 2
strTemp = f1.Name
StyleBox.AddItem (strTemp)
End If
Next
' End If
cleanup:
Set fs = Nothing
Set f = Nothing
Set fc = Nothing
End Sub

snb
05-13-2016, 12:12 PM
This is awful


Private Sub UserForm_Initialize()
GetStyleTypes
StyleTypes.Show
End Sub

it should read


Private Sub UserForm_Initialize()
GetStyleTypes
End Sub

snb
05-13-2016, 12:18 PM
much easier/faster to accomplish with :


Sub Userform_initialize()
with CreateObject("Scripting.FileSystemObject")
for each it in .GetFolder(Directory).Files
If ucase(.getextensionname(it)) = "XLS" Then c00=c00 & "|" &it.name
Next

StyleBox.list=split(mid(c00,2),"|")
end with
End Sub

p45cal
05-13-2016, 01:31 PM
Kensington in Eastern hemisphere!!

sollijones
05-16-2016, 12:47 PM
Thanks. Actually, the code didn't work until I added the "StyleTypes.Show" line.

The macro is now working as intended. Thank you for all of your assistance.

Regards,
SOJ


This is awful


Private Sub UserForm_Initialize()
GetStyleTypes
StyleTypes.Show
End Sub

it should read


Private Sub UserForm_Initialize()
GetStyleTypes
End Sub

bhouston113
11-08-2016, 10:46 AM
Another newb trying to figure out a workaround for filesearch.

I'm not a VBA guy, I have recorded Macros and such in the past and edited some VBA code before but this is killing me. My site just updated their MS products to 2013 and this was written for 2003 so the Filesearch option doesn't work. I know this needs to be updated but I have NO idea how.

Here is the code:



With Application.FileSearch
.LookIn = p
.Filename = "*.*"
If .Execute() > 0 Then
For i = 1 To .FoundFiles.Count
NumberofRuns = .FoundFiles.Count
Filename = .FoundFiles(i)

Sheets("GM Template").Copy After:=Sheets(i + 2 + k)
Sheets("GM Template (2)").Name = "GM Table " & i
Sheets("S&H Template").Copy After:=Sheets(i + 3 + k)
Sheets("S&H Template (2)").Name = "S&H Run " & i

Workbooks.OpenText Filename:=Filename _
, Origin:=xlWindows, StartRow:=1, DataType:=xlDelimited, TextQualifier _
:=xlDoubleQuote, ConsecutiveDelimiter:=False, Tab:=True, Semicolon:= _
False, Comma:=False, Space:=False, Other:=False, FieldInfo:=Array(1, 1)
MyReport = ActiveWorkbook.Name
Range("A1").Select
Selection.End(xlDown).Select
RowEnd = ActiveCell.Row
Range("A1").Select
Selection.End(xlToRight).Select
ColumnEnd = ActiveCell.Column
Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Select
Cells.Select
Selection.Sort Key1:=Range(SearchColumn), Order1:=xlAscending, Key2:=Range("A2") _
, Order2:=xlAscending, Header:=xlYes, OrderCustom:=1, MatchCase:=False _
, Orientation:=xlTopToBottom
Range(Cells(1, 1), Cells(RowEnd, ColumnEnd)).Copy
Windows(MyBook).Activate
Sheets("GM Table " & i).Select
Range("A1").Select
ActiveSheet.Paste

Windows(MyReport).Activate
Application.DisplayAlerts = False
ActiveWorkbook.Close

If DyeSet = "DS33" Then
Call DS33
ElseIf DyeSet = "DS30" Then
Call DS30
ElseIf DyeSet = "Identifiler" Then
Call Identifiler
ElseIf DyeSet = "ProPlus" Then
Call ProPlus
ElseIf DyeSet = "SNaPshot" Then
Call SNaPshot
ElseIf DyeSet = "ALFP" Then
Call ALFP
End If

k = k + 1

Sheets("S&H Summary").Select
Range("B4").Select
If ActiveCell.Value <> False Then
Selection.End(xlToRight).Select
ColumnTracker = ActiveCell.Column
PasteColumn = ColumnTracker + 1
Else
PasteColumn = 2
End If

Sheets("S&H Run " & i).Select
Range("B2:C34").Copy
Sheets("S&H Summary").Select
Cells(4, PasteColumn).Select
Selection.PasteSpecial Paste:=xlValues
Selection.NumberFormat = "0.00"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Cells(3, PasteColumn).Value = "Run " & i

If CapFlag <> 0 Then
Cells(2, PasteColumn).Select
With Selection.Interior
.ColorIndex = 6
.Pattern = xlSolid
End With
Cells(2, PasteColumn).Value = CapFlag
ElseIf MissingFlag <> 0 Then
Cells(1, PasteColumn).Select
With Selection.Interior
.ColorIndex = 46
.Pattern = xlSolid
End With
Cells(1, PasteColumn).Value = MissingFlag
End If

For j = 5 To 5 + UBound(Alleles)
Cells(j, PasteColumn + 1).Select
If IsNumeric(ActiveCell.Value) = False Then
Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ElseIf ActiveCell.Value >= Precision Then
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
Next j

Sheets("S&H Run " & i).Select
Range("D2:E34").Copy
Sheets("S&H Summary").Select
Cells(39, PasteColumn).Select
Selection.PasteSpecial Paste:=xlValues
Selection.NumberFormat = "0.0"
Selection.Borders(xlDiagonalDown).LineStyle = xlNone
Selection.Borders(xlDiagonalUp).LineStyle = xlNone
With Selection.Borders(xlEdgeLeft)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeTop)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeBottom)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlEdgeRight)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideVertical)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
With Selection.Borders(xlInsideHorizontal)
.LineStyle = xlContinuous
.Weight = xlThin
.ColorIndex = xlAutomatic
End With
Cells(38, PasteColumn).Value = "Run " & i

For j = 40 To 40 + UBound(Alleles)
Cells(j, PasteColumn).Select
If IsNumeric(ActiveCell.Value) = False Then
Range(Cells(j, PasteColumn), Cells(j, PasteColumn + 1)).Select
Selection.ClearContents
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
ElseIf ActiveCell.Value <= 150 And ActiveCell.Value <> "" And DyeSet <> "ALFP" Then
With Selection.Interior
.ColorIndex = 3
.Pattern = xlSolid
End With
End If
Next j

Cells(73, PasteColumn).Value = MyReport

Next i
Else
MsgBox ("Empty Folder")
Exit Sub
End If
End With


If DyeSet = "DS33" Then
Call DS33Summary
ElseIf DyeSet = "DS30" Then
Call DS30Summary
ElseIf DyeSet = "Identifiler" Then
Call IdentifilerSummary
ElseIf DyeSet = "ProPlus" Then
Call ProPlusSummary
ElseIf DyeSet = "SNaPshot" Then
Call SNaPshotSummary
ElseIf DyeSet = "ALFP" Then
Call ALFPSummary
End If


End Sub