Printable View
Sorry, John.
This has progressed a wee bit. The problem is that the style names have become corrupt.
I did try your workbook, tho. It did nothing in 2003 (but no error) and threw the same error in 2000.
See: http://www.experts-exchange.com/Appl..._21356767.html
It's only marked Solved at EE 'cause I believe the issue is with the corrupt styles, not the code.
Quote:
Originally Posted by Dreamboat
Hi Anne,
The problem that I see is that "Normal" in any particular workbook is user-defined, the style name "Normal" is an Office default, but that doesn't mean the settings for the book are Office default - they're always user defined.
Bexause of the many different styles used in all these books (opened on the same application) perhaps "Normal" itself has been corrupted and needs to be re-defined, something like this maybe?[vba]Option Explicit
Sub ChangeStyle()
Dim N&, Style As Style
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
'//Define your own "Normal" style here
'*******************************
With ActiveWorkbook.Styles("Normal")
.IncludeNumber = True
.IncludeFont = True
.IncludeAlignment = True
.IncludeBorder = True
.IncludePatterns = True
.IncludeProtection = True
.HorizontalAlignment = xlGeneral
.VerticalAlignment = xlBottom
.ReadingOrder = xlContext
.WrapText = False
.Orientation = 0
.AddIndent = False
.ShrinkToFit = False
.NumberFormat = "General"
.Borders(xlLeft).LineStyle = xlNone
.Borders(xlRight).LineStyle = xlNone
.Borders(xlTop).LineStyle = xlNone
.Borders(xlBottom).LineStyle = xlNone
.Borders(xlDiagonalDown).LineStyle = xlNone
.Borders(xlDiagonalUp).LineStyle = xlNone
.Interior.Pattern = xlNone
.Locked = True
.FormulaHidden = False
End With
With ActiveWorkbook.Styles("Normal").Font
.Name = "Arial"
.Size = 10
.Bold = False
.Italic = False
.Underline = xlUnderlineStyleNone
.Strikethrough = False
.ColorIndex = xlAutomatic
End With
Selection.Style = "Normal"
'***********************************
ActiveWorkbook.Close savechanges:=True
End If
Next N
End If
End With
End Sub[/vba]
Nope. The whole problem lies in that some of the style names aren't recognizable by the code. There's no problem with normal. We just want to unload hundreds of styles stored in the files.
Hi Ron,
Just had a look at the workbook you emailed me. The problem is that the names of some of the "styles" aren't styles at all, their names are actually number formats and so on and this is causing the error. i.e. they're not proper names for a style...
Added to this, there are almost 3000 of these "styles". The procedure below will delete all but about 12 of them.
Of the remainder, some can be deleted 'by hand' and some can't. I don't know exactly what has been put in as "styles" {e.g. one of these remaining "styles" is =C:\\WINNT\SYSTEM35\COMMAND. (something)}. I'll leave these for someone else to look at...
This procedure is slow (it takes about one minute to do the test book you sent) but it will clean it up quite a bit and I'm sure someone else will improve on it.[vba]Option Explicit
Sub DoThis()
Dim i&
Application.ScreenUpdating = False
Sheets.Add before:=Sheets(1)
For i = 1 To ActiveWorkbook.Styles.Count
[A65536].End(xlUp).Offset(1, 0) = ActiveWorkbook.Styles(i).Name
Next
[A2].Select
Do
If Selection.Text Like "Normal" Then
Selection.Offset(1, 0).Select
Else
On Error Resume Next '< it's number format
ActiveWorkbook.Styles(Selection.Text).Delete
On Error Resume Next '< it's text
ActiveWorkbook.Styles(Selection.NumberFormat).Delete
Selection.ClearContents
Selection.Offset(1, 0).Select
End If
Loop Until Selection.Text = Empty
Application.DisplayAlerts = False
ActiveSheet.Delete
End Sub[/vba]
Regards,
John
Hi guys,
Ron, I just wanted to apologize for not getting back to you at the TOE thread you started. I had registered for the first time there to provide you with the code I posted, and did't realize that the defaults there were NOT to email you with posting notifications.
It looks like you're in good hands now though, but if I can be of any help to you, please don't hesitate to let me know and I'll do what I can.
John, quick Q for you... do you need the 2nd On Error Resume Next in the Else block? No Goto 0 either. Just curious if it's intentional or a typo? :dunno
Hi Ken,
The second On Errors's still in the larger loop and I wanted to make sure I completely cleared the error with the "Resume" before it loops back on itself.
I suppose Goto 0 may have also done the trick, but I just wanted A solution... It's not elegant (e.g. it would go much faster if all the "Selects" were eradicated) but it's a start-point.
Regards,
John
Ron: This's a bit better version of the code above, it cuts the time down to almost half of the previous:[vba]Sub ClearStyles()
Dim i&, Cell As Range, RangeOfStyles As Range
Application.ScreenUpdating = False
'Add a temporary sheet
Sheets.Add before:=Sheets(1)
'List all the styles
For i = 1 To ActiveWorkbook.Styles.Count
[a65536].End(xlUp).Offset(1, 0) = ActiveWorkbook.Styles(i).Name
Next
Set RangeOfStyles = Range(Columns(1).Rows(2), Columns(1).Rows(65536).End(xlUp))
For Each Cell In RangeOfStyles
If Cell.Text Like "Normal" Then
Cell.Offset(1, 0).Select
Else
On Error Resume Next
ActiveWorkbook.Styles(Cell.Text).Delete
ActiveWorkbook.Styles(Cell.NumberFormat).Delete
End If
Next Cell
'delete the temp sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
End Sub[/vba]
JOHHHNNNNN!!!!
you are awesome man!!! I SOOOO Appreciate you and Dreamboat. And thanks KPULS TOO!
This worked! OH MY LORD! LOL
Yes JOHN final request, if you could do it with a loop. Also, those corrupt styles shouldn't matter, but if anyone does come up with anything, let me know.
rongr75
-- wish i could buy you all a beer!
You can, Ron!!Quote:
Originally Posted by rongr75
Just make a small donation at the PayPal link...
Hee hee.
We take ANY size donation!
:)
Hi Ron,
Glad to see you like it.:thumb
Here's the procedure in a loop... put it in a workbook with all the books whose styles you want to clear and it'll clear all the workbooks in the folder but - because of the sheer number (~3000) of styles in each book, it may take around a minute a book (depends on your computer) so, if you have a REAL LOT of books like this you better run it when you don't need the computer (say overnight). Here's the code for the loop....
(I've also put it into an attachment here that you can download and use)[vba]Option Explicit
'<< CLEAR THE STYLES FROM ALL BOOKS IN THIS FOLDER >>
Sub ClearStyles()
Dim i&, N&, Cell As Range, RangeOfStyles As Range
Application.ScreenUpdating = False
With Application.FileSearch
.LookIn = ActiveWorkbook.Path
.Filename = "*.xls"
If .Execute > 0 Then
For N = 1 To .FoundFiles.Count
If .FoundFiles(N) <> ThisWorkbook.FullName Then
Application.Workbooks.Open(.FoundFiles(N)).Activate
'Clear Styles
'********************************************
'Add a temporary sheet
Sheets.Add before:=Sheets(1)
'List all the styles
For i = 1 To ActiveWorkbook.Styles.Count
[a65536].End(xlUp).Offset(1, 0) = ActiveWorkbook. _
Styles(i).Name
Next
Set RangeOfStyles = Range(Columns(1).Rows(2), _
Columns(1).Rows(65536).End(xlUp))
For Each Cell In RangeOfStyles
If Cell.Text Like "Normal" Then
Cell.Offset(1, 0).Select
Else
On Error Resume Next
ActiveWorkbook.Styles(Cell.Text).Delete
ActiveWorkbook.Styles(Cell.NumberFormat).Delete
End If
Next Cell
'********************************************
'delete the temp sheet
Application.DisplayAlerts = False
ActiveSheet.Delete
ActiveWorkbook.Close savechanges:=True
End If
Next N
End If
End With
End Sub[/vba]
Regards,
John :devil:
PS so you can marked this solved?
John: Thanks a bunch. You're so giving of your time...
Not a prob....(I enjoy the challenge)
John!
Why hasn't the KB Bot said anything about this entry yet? ;)
Give us a hour or two! :whip I only just woke up...:devil:Quote:
Originally Posted by kpuls