Updating Text Format in a Shape using VBA

[Ruts]

Hey everyone, I wrote this bit of vba quite some time ago (2017) to run a little bingo caller for a social team where I was - keeping excel up to date wasn't something they were good at - so the version at the time worked.

They have now updated to O365 and the reformatting of the text in the shape does not seem to apply anymore. I can't work out the new syntax to get this to apply. Any help would be greatly appreciated.

        Sheet2.Shapes("shWinner").Select
            With Selection.Characters(Start:=1, Length:=100).Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 180
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 10
            End With

 

[Fluff]

In what way doesn't it work?
Also how big is the shape?

 

[Ruts]

In what way doesn't it work?
Also how big is the shape?

The number does not refresh to the prescribed font size as per the code - so it shows as small text in a big box. The value is linked to a cell - so the text in the shape =$C$3

It is probably a convoluted way to do it - and a text box might just be easier now that I think about it.

An image of how it looks on screen is below.

 

[Fluff]

You're code works fine for me, but try it like

        With Sheet2.Shapes("shWinner").TextFrame.Characters.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 180
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 10
            End With

 

[Ruts]

You're code works fine for me, but try it like

        With Sheet2.Shapes("shWinner").TextFrame.Characters.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 180
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 10
            End With

Unfortunately it is still the same. Could it be a 64 bit issue?

 

[Fluff]

I wouldn't have thought so. How is the code being run? Also do you get any error messages?

 

[Ruts]

I wouldn't have thought so. How is the code being run? Also do you get any error messages?

The code is a piece of a larger macro called through it's assignment to a button/shape click.

The design is to pick a random number from 1-75, mark that number as drawn (by placing a # in column B on the same row as the number drawn, then show that crawn number in the shape, and make it BIG.

the full code is as follows:

Public nMarked As Boolean

Sub doDraw()
'This macro will count the records (again) then
' generate a random number, check it is not already
' drawn, then display the detail about that draw.
' It will mark a drawn number so it can ignore it later.

' Assign variable formats
Dim nDrawn As Long
Dim LastRow As Long
Dim cLoop As Long
Dim cCount As Long
Dim wName As String
Dim roll As Integer
Dim stall As Double
Dim counter As Long

Application.ScreenUpdating = False

' Make sure we are on the right page
Sheet1.Activate

' Determine last row based on LineCount column (A) of Sheet1
    LastRow = 75 'now a fixed variable

' Check if there are numbers to be drawn
    For cLoop = 1 To LastRow
        If Sheet1.Cells(cLoop, 2) > 0 Then
            cCount = cCount + 1
            If cCount = LastRow Then
                MsgBox "Sorry There are no numbers left to draw"
                Exit Sub
            End If
        End If
    Next cLoop
  
' Let's draw a number
    nDrawn = 0 'reset the number - not really required but good practice.
    nDrawn = Int(Rnd() * LastRow) + 1

' Check we haven't marked it as prerolled
    If Sheet1.Cells(nDrawn, 2) = "#" Then
        nMarked = True
    Else
        nMarked = False
    End If

' Mark Selected Numbers and display a result
   If nMarked = False Then
        ActiveSheet.Unprotect
        Sheet1.Cells(nDrawn, 2).Formula = "#"
        Sheet1.Cells(1, 3).Formula = Sheet1.Cells(nDrawn, 1).Value
        With Sheet1.Shapes("shWinner").TextFrame.Characters.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 180
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 10
        End With
        Sheet1.Cells(22, 10).Select
        ActiveSheet.Protect DrawingObjects:=True, Contents:=True, Scenarios:=True
        nMarked = False
        Application.ScreenUpdating = True
    Else
        doDraw 'Lets start the roll again
    End If
End Sub

 

[Fluff]

That code works for me, try stepping through it using F8 & see if it gets to the part where it's formatting the text in the shape.

 

[Ruts]

That code works for me, try stepping through it using F8 & see if it gets to the part where it's formatting the text in the shape.

It does run through every line - I commented out the screen updating as well and it makes no difference
I also included a line before the text changes to select the shape, which it does - so the shape referencing is correct, just the triggering of font and size does not seem to have any effect

 

[Fluff]

Not sure why it's not working for you. However another option is to remove the formula & just use

Sheet1.Shapes("shWinner").TextFrame.Characters.Text = Sheet1.Cells(nDrawn, 1).Value

instead of

        With Sheet1.Shapes("shWinner").TextFrame.Characters.Font
                .Name = "Arial"
                .FontStyle = "Bold"
                .Size = 180
                .Strikethrough = False
                .Superscript = False
                .Subscript = False
                .OutlineFont = False
                .Shadow = False
                .Underline = xlUnderlineStyleNone
                .ColorIndex = 10
        End With

And just set the format manually.