Run-time error '445' - Object doesn't support this activity

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

Code:

---

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 -

Code:

---

' 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

---

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...

Code:

---

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

---

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.

Quote:

---

Originally Posted by Leith Ross

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...

Code:

---

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

---

---

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

GTO, I received the following message:
"Cannot jump to 'Show' because it is hidden."

Quote:

---

Originally Posted by GTO

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

---

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

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

Quote:

---

Originally Posted by GTO

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

---

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...

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

Quote:

---

Originally Posted by GTO

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...

---

"Show" is not an object, it is a method. This is what the first sub in your first post is saying

Code:

---

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

---

Quote:

---

Originally Posted by GTO

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...

Quote:

---

Originally Posted by sollijones

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

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

Quote:

---

Originally Posted by GTO

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

---

This will solve your problem:

Code:

---

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

---

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

Quote:

---

Originally Posted by snb

This will solve your problem:

Code:

---

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

---

---

This is awful

Code:

---

Private Sub UserForm_Initialize()
            GetStyleTypes
            StyleTypes.Show
End Sub

---

it should read

Code:

---

Private Sub UserForm_Initialize()
  GetStyleTypes
            End Sub

---

much easier/faster to accomplish with :

Code:

---

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

---

Kensington in Eastern hemisphere!!

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

Quote:

---

Originally Posted by snb

This is awful

Code:

---

Private Sub UserForm_Initialize()
            GetStyleTypes
            StyleTypes.Show
End Sub

---

it should read

Code:

---

Private Sub UserForm_Initialize()
  GetStyleTypes
            End Sub

---

---

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:

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

---