[Okta Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 622
  • Last Modified:

Excel 2003 - Selection.Formula = txtboxFormula (named range) - Not compatible with Excel 2010 - Help Please

I've been asked to assist a client with upgrading an old Excel spreadsheet (2003) to 2010.
Another coder performed the work, and I'm new to 2010, although reasonably familiar with VBA.

The code was developed to build complex shop drawings - using various textboxes and shapes, linked to name ranges. The first section I need help with relates to the use of TextBoxes. From my research 2010 uses a new TextBoxes control which was not present in 2003.

Lines that have Selection.Formula = textboxFormula - are no longer compatible and produce the following error:

Unable to set the Formula property of the TextBox class.

Any and all help would be appreciated.





Sub UpdateDrawingLinks(apr As Boolean)
    Dim msg As String
    ActiveSheet.Range("A1").Select

    ' Change links to link to current workbook
    Dim alinks As Variant
    Dim i As Integer
    alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(alinks) Then
        For i = 1 To UBound(alinks)
            ActiveWorkbook.ChangeLink alinks(i), ActiveWorkbook.FullName, xlExcelLinks
        Next i
    End If

    ' Check whether there are any remaining links to other workbooks
    ' You should never get this error but during development sometimes this occurred
    alinks = ActiveWorkbook.LinkSources(xlExcelLinks)
    If Not IsEmpty(alinks) Then
        MsgBox "** Warning **" & Chr(13) & "There are unresolved links to other spreadsheets!"
        For i = 1 To UBound(alinks)
            msg = msg & alinks(i) & " *** "
        Next i
        MsgBox msg
    End If


    ' Reactive the formula that link the text boxes to worksheet cells
    ' This is required since the textboxes with named rang links did not always update to the current value in the cell
    
    Dim sh, gsh As Shape, txtboxFormula As String
    
    For Each sh In ActiveSheet.Shapes
        
        If sh.Type = msoTextBox Then
            ' the shape is a text box
            sh.Select   ' select the object
            'Note the .formula property seems to work with text boxes only if you select them individually
            txtboxFormula = Selection.Formula
            If txtboxFormula <> "" Then
                ' update the formula
                Selection.Formula = txtboxFormula
                Selection.Font.ColorIndex = 1           ' change colour to black
                'If apr Then Selection.Font.Size = 10
                'sh.TextFrame.AutoSize = msoTrue        'ensure the text box expands to the linked value
            End If
        ElseIf sh.Type = msoGroup Then
            ' shape is a group run through each shape in the group
            'If apr Then Selection.Font.Size = 10
            For Each gsh In sh.GroupItems
                If gsh.Type = msoTextBox Then
                    ' the shape is a text box
                    gsh.Select   ' select the object
                    'Note the .formula property seems to work with text boxes only if you select them individually
                    txtboxFormula = Selection.Formula
                    If txtboxFormula <> "" Then
                        ' update the formula
                        Selection.Formula = txtboxFormula
                        Selection.Font.ColorIndex = 1           ' change colour to black
                        'If apr Then Selection.Font.Size = 10
                        'gsh.TextFrame.AutoSize = msoTrue        'ensure the text box expands to the linked value
                    End If
                Else
                    'MsgBox "Other type"
                End If
            Next
        End If
    Next

    Set sh = Nothing
    ActiveSheet.Range("A1").Select
    Exit Sub
errorHandler:
    MsgBox "Unexpected Error when updating links"
End Sub

Open in new window

0
B_Michael
Asked:
B_Michael
  • 11
  • 5
2 Solutions
 
SiddharthRoutCommented:
I am doing this from memory so I could be wrong.

'~~> Clear the text first
Shp.groupItems("Shape1").oleformat.object.text=""
'~~> Update Formula
Shp.groupItems("Shape1").oleformat.object.formula = txtboxFormula

Open in new window


Sid
0
 
B_MichaelAuthor Commented:
Thanks for the quick reply.

Could you please advise where this new code would sit within the code presented and how to cater for multiple names for each textbox eg Shape1 = Textbox 6936 etc....

Sorry I'm a bit slow on it today after a long week and now easter coming....
0
 
SiddharthRoutCommented:
Ok, Do you have the actual workbook? maybe I can give you the exact code then :)

Sid
0
Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

 
B_MichaelAuthor Commented:
Mate, I'd love to, but workbook contains a bunch of confidential data, which I'm not authorised to distribute?

From what I can tell each shape or TextBox is located via the looping code I've uploaded, and then reconnected to corresponding cell references in a sheet within the workbook.

My question is do I need to add additional code to reference the name of the shape in your code?

Thanks for all your great help
0
 
SiddharthRoutCommented:
Can you make a copy of your file and then delete all sheets but one and delete all the sensitive info leaving the textboxes untouched and then upload the file?

Sid
0
 
B_MichaelAuthor Commented:
Sid,

Will do later today and upload, thanks for all your help.

Cheers

Michael
0
 
B_MichaelAuthor Commented:
Sid,

I've included the code as requested, but altered the calcs to preserve confidentiality.

I've also included the drawing files that need to be placed in a directory called C:/Program Files/StepUp/Libraries in order to run the code.

The code I am attempting to make compatible with 2010 is triggered from the green colored tabs.

All help appreciated!

Thanks very much for your help.

Michael
StepUp-2011-Public.xlsm
ShopDrawingLibrary.xls
HandrailDrawingLibrary.xls
ApprovalDrawingLibrary.xls
0
 
B_MichaelAuthor Commented:
Any update or further help appreciated. Thanks
0
 
SiddharthRoutCommented:
Sorry got held up in something. Try this file for me. Is this what you want? If it is then I will share the code here.

BTW, You will have to change the path in the "Constants" Sheet.

Sid
StepUp-2011-Public.xlsm
0
 
B_MichaelAuthor Commented:
Thanks very much Sid,

Good news the code now seems to be compatible.

Bad news the new code seems to be putting the formula as text into the next box rather than the result of the formula e.g =StairCalcs$B$26 instead of result 150?

Thanks so much for all your great help, need to get back to client by end of this week, if you are able to assist I'd really appreciate it.

Cheers

Michael
0
 
B_MichaelAuthor Commented:
Sid,

Any update appreciated as I need to get this sorted for the client.

Thanks

Michael
0
 
B_MichaelAuthor Commented:
Guys - any help appreciated - I have the client breathing down my neck.

Thanks

Michael
0
 
SiddharthRoutCommented:
Sorry was out on weekend.

I found out the error :)

Change the line

Selection.Formula = txtboxFormula

To

Selection.Formula = "=" & Trim(txtboxFormula)

and it will work fine :)

Sample attached. Please reset the Library location.

Sid
StepUp-2011-Public.xlsm
0
 
B_MichaelAuthor Commented:
Thanks Sid - I'll let you know how I go....
0
 
B_MichaelAuthor Commented:
Sid all looking good, waiting for Customers final OK.

Thanks again for all your help
0
 
B_MichaelAuthor Commented:
Excellent work from Sid
0

Featured Post

[Webinar] Cloud and Mobile-First Strategy

Maybe you’ve fully adopted the cloud since the beginning. Or maybe you started with on-prem resources but are pursuing a “cloud and mobile first” strategy. Getting to that end state has its challenges. Discover how to build out a 100% cloud and mobile IT strategy in this webinar.

  • 11
  • 5
Tackle projects and never again get stuck behind a technical roadblock.
Join Now