Home |
Search |
Today's Posts |
#1
Posted to microsoft.public.excel.programming
|
|||
|
|||
Renaming styles
Dear group,
I want to rename styles using VBA. I do this by creating a new style-object and copying all properties from the old style to the new one. Then I assign the new style to the cells and delete the old style. Problem: It is working, but with bigger workbooks it is very slowly. Am I thinking too complicated? The code ist listed below. Thanks in advance, Holger. -------------------------------------------------------------------------------------------- Private Sub RenameStyle(wb As Workbook, OldName As String, NewName As String) On Error Resume Next Dim sh As Worksheet Dim c As Range Dim styleFrom As Style, styleTo As Style Set styleFrom = wb.Styles(OldName) Set styleTo = wb.Styles.Add(NewName) ' Copy style With styleTo .IncludeNumber = styleFrom.IncludeNumber .IncludeFont = styleFrom.IncludeFont .IncludeAlignment = styleFrom.IncludeAlignment .IncludeBorder = styleFrom.IncludeBorder .IncludePatterns = styleFrom.IncludePatterns .IncludeProtection = styleFrom.IncludeProtection End With styleTo.NumberFormat = styleFrom.NumberFormat With styleTo.Font .Name = styleFrom.Font.Name .Size = styleFrom.Font.Size .Bold = styleFrom.Font.Bold .Italic = styleFrom.Font.Italic .Underline = styleFrom.Font.Underline .Strikethrough = styleFrom.Font.Strikethrough .ThemeColor = styleFrom.Font.ThemeColor .ColorIndex = styleFrom.Font.ColorIndex .Color = styleFrom.Font.Color If .ThemeColor < styleFrom.Font.ThemeColor Then .ThemeColor = styleFrom.Font.ThemeColor End If .TintAndShade = styleFrom.Font.TintAndShade .ThemeFont = styleFrom.Font.ThemeFont End With With styleTo .HorizontalAlignment = styleFrom.HorizontalAlignment .VerticalAlignment = styleFrom.VerticalAlignment .ReadingOrder = styleFrom.ReadingOrder .WrapText = styleFrom.WrapText .Orientation = styleFrom.Orientation .AddIndent = styleFrom.AddIndent .ShrinkToFit = styleFrom.ShrinkToFit End With With styleTo.Borders(xlLeft) .LineStyle = styleFrom.Borders(xlLeft).LineStyle If styleFrom.Borders(xlLeft).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlLeft).TintAndShade .Weight = styleFrom.Borders(xlLeft).Weight .ThemeColor = styleFrom.Borders(xlLeft).ThemeColor .ColorIndex = styleFrom.Borders(xlLeft).ColorIndex .Color = styleFrom.Borders(xlLeft).Color If .ColorIndex < styleFrom.Borders(xlLeft).ColorIndex Then .ColorIndex = styleFrom.Borders(xlLeft).ColorIndex End If If .ThemeColor < styleFrom.Borders(xlLeft).ThemeColor Then .ThemeColor = styleFrom.Borders(xlLeft).ThemeColor End If End If End With With styleTo.Borders(xlRight) .LineStyle = styleFrom.Borders(xlRight).LineStyle If styleFrom.Borders(xlRight).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlRight).TintAndShade .Weight = styleFrom.Borders(xlRight).Weight .ThemeColor = styleFrom.Borders(xlRight).ThemeColor .ColorIndex = styleFrom.Borders(xlRight).ColorIndex .Color = styleFrom.Borders(xlRight).Color If .ThemeColor < styleFrom.Borders(xlRight).ThemeColor Then .ThemeColor = styleFrom.Borders(xlRight).ThemeColor End If If .ThemeColor < styleFrom.Borders(xlRight).ThemeColor Then .ThemeColor = styleFrom.Borders(xlRight).ThemeColor End If End If End With With styleTo.Borders(xlTop) .LineStyle = styleFrom.Borders(xlTop).LineStyle If styleFrom.Borders(xlTop).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlTop).TintAndShade .Weight = styleFrom.Borders(xlTop).Weight .ThemeColor = styleFrom.Borders(xlTop).ThemeColor .ColorIndex = styleFrom.Borders(xlTop).ColorIndex .Color = styleFrom.Borders(xlTop).Color If .ThemeColor < styleFrom.Borders(xlTop).ThemeColor Then .ThemeColor = styleFrom.Borders(xlTop).ThemeColor End If If .ThemeColor < styleFrom.Borders(xlTop).ThemeColor Then .ThemeColor = styleFrom.Borders(xlTop).ThemeColor End If End If End With With styleTo.Borders(xlBottom) .LineStyle = styleFrom.Borders(xlBottom).LineStyle If styleFrom.Borders(xlBottom).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlBottom).TintAndShade .Weight = styleFrom.Borders(xlBottom).Weight .ThemeColor = styleFrom.Borders(xlBottom).ThemeColor .ColorIndex = styleFrom.Borders(xlBottom).ColorIndex .Color = styleFrom.Borders(xlBottom).Color If .ThemeColor < styleFrom.Borders(xlBottom).ThemeColor Then .ThemeColor = styleFrom.Borders(xlBottom).ThemeColor End If If .ThemeColor < styleFrom.Borders(xlBottom).ThemeColor Then .ThemeColor = styleFrom.Borders(xlBottom).ThemeColor End If End If End With With styleTo.Borders(xlDiagonalDown) .LineStyle = styleFrom.Borders(xlDiagonalDown).LineStyle If styleFrom.Borders(xlDiagonalDown).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlDiagonalDown).TintAndShade .Weight = styleFrom.Borders(xlDiagonalDown).Weight .ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor .ColorIndex = styleFrom.Borders(xlDiagonalDown).ColorIndex .Color = styleFrom.Borders(xlDiagonalDown).Color If .ThemeColor < styleFrom.Borders(xlDiagonalDown).ThemeColor Then .ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor End If If .ThemeColor < styleFrom.Borders(xlDiagonalDown).ThemeColor Then .ThemeColor = styleFrom.Borders(xlDiagonalDown).ThemeColor End If End If End With With styleTo.Borders(xlDiagonalUp) .LineStyle = styleFrom.Borders(xlDiagonalUp).LineStyle If styleFrom.Borders(xlDiagonalUp).LineStyle < xlNone Then .TintAndShade = styleFrom.Borders(xlDiagonalUp).TintAndShade .Weight = styleFrom.Borders(xlDiagonalUp).Weight .ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor .ColorIndex = styleFrom.Borders(xlDiagonalUp).ColorIndex .Color = styleFrom.Borders(xlDiagonalUp).Color If .ThemeColor < styleFrom.Borders(xlDiagonalUp).ThemeColor Then .ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor End If If .ThemeColor < styleFrom.Borders(xlDiagonalUp).ThemeColor Then .ThemeColor = styleFrom.Borders(xlDiagonalUp).ThemeColor End If End If End With With styleTo.Interior .Pattern = styleFrom.Interior.Pattern .PatternThemeColor = styleFrom.Interior.PatternThemeColor .PatternColorIndex = styleFrom.Interior.PatternColorIndex .PatternColor = styleFrom.Interior.PatternColor If .PatternThemeColor < styleFrom.Interior.PatternThemeColor Then .PatternThemeColor = styleFrom.Interior.PatternThemeColor End If .ThemeColor = styleFrom.Interior.ThemeColor .ColorIndex = styleFrom.Interior.ColorIndex .Color = styleFrom.Interior.Color If .ThemeColor < styleFrom.Interior.ThemeColor Then .ThemeColor = styleFrom.Interior.ThemeColor End If .TintAndShade = styleFrom.Interior.TintAndShade .PatternTintAndShade = styleFrom.Interior.PatternTintAndShade End With With styleTo .Locked = styleFrom.Locked .FormulaHidden = styleFrom.FormulaHidden End With ' Assign new style to cells For Each sh In wb.Sheets For Each c In sh.UsedRange.Cells If c.Style.Name = styleFrom.Name Then c.Style = styleTo.Name End If Next c Next sh ' Delete old style styleFrom.Delete End Sub |
Reply |
Thread Tools | Search this Thread |
Display Modes | |
|
|
Similar Threads | ||||
Thread | Forum | |||
some unknown Cell styles are shown in cell styles | Excel Worksheet Functions | |||
Renaming Styles in Excel | Excel Discussion (Misc queries) | |||
Excel Cell Styles - Quick Styles? | Excel Discussion (Misc queries) | |||
re-naming styles | Excel Programming | |||
Can I code Styles | Excel Programming |