Shape.TextEffect.HorizontalAlignment throws error

[Anand Nichkaode]

Hi,

I have an Excel Add-in(XLAM) which opens a workbook and works on it. Among
the things "Pasting Formula As Values" is one of the things which is
performed on the workbook opened. The workbook opened could be an Excel
97-2003 or Excel 2007 workbook.

Depending upon the worksheets for which this option is applicable, the Addin
loops through the sheets and pastes them as values.

In Paste Formula As values option together with cells, all the shapes (i.e.
textboxes, arrows, callouts, stars and banners, etc), if there are any, are
also pasted as values by removing their formula. Here the Addin loops through
all the shapes on the particular sheet and removes the formula. Earlier it
was observed that when the formula of the shape is removed it loses certain
formatting options such as FonType, FontSize, FontBold, FontItalic,
Underline, FontColor. In order to preserve things, the Add-in now stores all
of these options and removes the formual and then re-applies these options on
the shape.

I found that certain shapes behave differently in Excel 2007 as compared to
Excel 97-2007. So in order to be consistent after some research I have come
up with the following code for preserving and re-appliying the formatting
options after removing the formula for a shape.

With objShp
objHAlign = .TextFrame.HorizontalAlignment
objFontName = .TextEffect.FontName
objFontSize = .TextEffect.FontSize
objFontBold = .TextEffect.FontBold
objFontItalic = .TextEffect.FontItalic
objFontUnderLine = .TextFrame2.TextRange.Font.UnderlineStyle
objFontColor = .TextFrame2.TextRange.Font.Fill.ForeColor.RGB

.DrawingObject.Formula = ""

.TextFrame.HorizontalAlignment = objHAlign
.TextEffect.FontName = objFontName
.TextEffect.FontSize = objFontSize
.TextEffect.FontBold = objFontBold
.TextEffect.FontItalic = objFontItalic
.TextFrame2.TextRange.Font.UnderlineStyle = objFontUnderLine
.TextFrame2.TextRange.Font.Fill.ForeColor.RGB = objFontColor
End With

Now this was working perfect untill the time that one of the
workbooks(97-2003) had some textboxes out of which one did not have the
formatting options specified. Because the textbox did not have formatting
options specified the code pasted above fails while getting the
..TextFrame.HorizontalAlignment property value with "Application-defined or
object-defined error" error.

During investigation I found that the TextFrame.HorizontalAlignment property
throws error if the textbox is not applied with the Horizontal alignment
option beforehand.

I am not sure how to handle this or any other way to achieve this.

Any help on this will be appreciated. Please let me know if you need anything.

Thanks in advance.

-Thx
Anand

 

[Peter T]

As you have found in 2007 when you remove a linked formula from a shape the
text's (ie font) format properties are lost, unlike in earlier versions. It
means doing pretty much as you are already, store the formats, remove the
linked formula, replace the formats.

I found that the TextFrame.HorizontalAlignment property
throws error if the textbox is not applied with the Horizontal alignment
option beforehand.

I'm not exactly sure what the problem is here with "some" textboxes. However
there are significant differences in the way shapes and the drawing layer
works in 2007 and earlier versions. Most shapes in earlier versions do not
have an associated textframe until text is added, maybe that's related, or
maybe if the linked formula is an empty cell removing the link removes the
textframe. It probably means adapting your code to different types of shapes
(eg w/out a textframe).

FWIW the code you posted, in earlier versions would only work partially with
a WordArt object (ie texteffect) and TextFrame2 is new to 2007.

A different approach you might try is to copy the original shape, remove the
formula, then reapply the formats using Pickup & Apply (a bit like
pastespecial formats to a shape)

Sub test()
Dim shp As Shape, shpTemp As Shape

Set shp = ActiveSheet.Shapes("Rectangle 1")
shp.Copy
ActiveSheet.Paste

With ActiveSheet.Shapes
Set shpTemp = .Item(.Count)
End With

shp.DrawingObject.Formula = ""

shpTemp.PickUp
shp.Apply
shpTemp.Delete

End Sub

The copied shape could be pasted to another sheet to avoid incrementing the
object ID counter, even onto a sheet in your addin. If you have loads to do
you could copy the first shape only, pickup/apply from subsequent shapes to
the temporary shape, remove formula, pickup.apply back again, only delete
the temp shape when done.

Regards,
Peter T

 

[Anand Nichkaode]

Thx a ton for the quick response.

As you have said my approach is not full proof it retains only the specified
formatting. So to retain other formatting options some extra code needs to be
put in place.

I tried the code you had suggested and works very well. I made a small
change, though am not sure if it would give any issues in future, is that
instead of copying the shape and pasting it somewhere else I PICKUP on the
same shape and remove formula and then APPLY on the same shape. The code is
as given below.

objShp.PickUp

objShp.DrawingObject.Formula = ""

objShp.Apply

I found that this works fine too. Please let me know if I should continue
with the changed code.

-Thx
Anand

 

[Peter T]

Good thinking Anand!
I use Pickup & Apply extensively as part of an undo (shape formatting). For
my purposes your simpler method wouldn't work but for what you're doing it
should be fine. Keep an eye on it though.

Regards,
Peter T