VBA Change Font In A Range On Worksheet

[John Caines]

Hello All.

I'd really like to insert a check box on my spreadsheet that can toggle on and off that creates a font change for my spreadsheet.
The font I'd like to toggle isn't a std inserted windows font,, but one I've installed in the fonts part of windows 7,, but it should be ok.
What I want to do is insert a check box somewhere on my spreadsheet which is called "ToDo-FULL" & the Target Range of Cells for the font change on my spreadsheet is C4:Q44. If the checkbox is checked it will insert a font called "Throw My Hands Up in the Air", Font Style "Regular", Font Size "12", Colour "Black"
If I uncheck,, it reverts back to the original font (Calibri, 12, reg,black).

I've searched the forum & found maybe a bit of code that might/could be adapted to do it.(I think)
Thing is,, I'm no coder, and I've just tried changing a few details to it,, it didn't work unsurprisingly

It was by a guy called Andrew Poulsom, and his code was;

'B1 style change
    For i = 2 To Sheets.Count
        With Sheets(i).Range("B1")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 11
            End With
            With .Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            ' Worksheets text in black
            With Sheets(i).Cells.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        End With
    Next i

I tried it as to wing it and just tried..

Private Sub Worksheet_Font_Change()

'C5:Q44 style change
    For i = 2 To Sheets.Count
        With Sheets("i").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
            With .Interior
                .Pattern = xlNone
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
            ' Worksheets text in black
            With Sheets("i").Cells.Font
                .ColorIndex = xlAutomatic
                .TintAndShade = 0
            End With
        End With
    Next i
End Sub

I'm not sure what

 For i = 2 To Sheets.Count

means,, maybe this isn't correct.
Maybe it needs to be completely different code altogether?

If anybody can help me please I'd appreciate it a lot.

It would be a really cool feature, If I could get it to work.
many thanks for your time
All the best
John Caines

 

[guerillaunit]

First function will turn your font to your custom font. Second function will return it to calibri

Private Sub Worksheet_Font_Change1()
        With Sheets("nameofurtab").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
End Sub

Private Sub Worksheet_Font_Change2()
        With Sheets("nameofurtab").Range("C5:Q44")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 12
            End With
End Sub

 

[John Caines]

Many thanks for your reply guerillaunit,,,
I'm not sure how to insert this though?
I've tried,, & I can't do it?

I'm a bit of a novice in VB,, but I have inserted macros before,, but I can't seem to do this 1

My steps are;
Go To Insert/Choose Form Control & select a checkbox. (Maybe Activex is better?? Not sure?)
Next I right Click & go assign macro Macro name is CheckBox_8_Click ,,, As a note,, why isn't it checkbox_1?? I don't have any checkboxes inserted yet,, been trying & deleted them,, but they are going up in number still?????

I then click NEW
This opens VB A Module is already created called;

Sub CheckBox8_Click()

End Sub

Now how do I insert your 2 formulas into this 1 module??

Formulas would be;

Private Sub Worksheet_Font_Change1()
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
End Sub


Code:

Private Sub Worksheet_Font_Change2()
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 12
            End With
End Sub

I just need to get this bit right,, then I save & go back to the checkbox,, right click & select Checkbox8 as the macro,,
then it should work on toggle.

If you can advise me on how to insert this please.
Maybe is it better to write the 2 in 1 sub??????
just an Idea.
many thanks again guerillaunit.

All the best
john Caines

 

[guerillaunit]

Change

Sub CheckBox8_Click()

End Sub

to

Sub CheckBox8_Click()
        With Sheets("nameofurtab").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
End Sub

 

[John Caines]

Many Thanks for your reply guerillaunit,,
But,,, I'm getting now a Compile error: Pop Up

It says;
"Expected End With"

So I just tried inserting another End With,,,
Now If I click the Check box The Sheet does change FONT!!!!
Great stuff,,,,,,,

But,, If I uncheck,,,
It doesn't change back to the Calibri Font

Any Ideas guerillaunit...???
Great stuff though,, half way there!!
Many thanks again,,
just needs a little TLC

All the best
JC

 

[John Caines]

Just To Add,
I now have;

Sub CheckBox12_Click()
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
End Sub

This changes all the sheet selection to the new font,,but how now to change this back to Calibri font as before ,, by unchecking the same box??
Help!
50% home and dry,,
I'll play and see if I can wing it,, not sure how to though

All the best
JC

 

[guerillaunit]

Sub CheckBox8_Click()
        If Sheets("sheet4").DrawingObjects("Check Box 1").Value > 0 Then
        With Sheets("sheet4").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
        Else
        With Sheets("sheet4").Range("C5:Q44")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
        End If
End Sub

Remeber to change "sheet4" to your actual sheet name

 

[John Caines]

guerillaunit,,, You're the man!!

Excellent job,, works now perfectly,,, really really great.

I'm in a new sheet now.
the formula now stands as;

Sub CheckBox2_Click()
        If Sheets("ToDo-FULL").DrawingObjects("Check Box 2").Value > 0 Then
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
        Else
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
        End If
End Sub

Still not sure why I can't change the check box's name which shows as Check Box 2 ,,, & change it to check box 1?????
Excel in the naming box won't allow me to call it that?
If I change it and click save,, it just reverts back to calling it check box 2
yet,, This is my only check box in the sheet

Very strange.
Anyway,,,
Many thanks again for your help here guerillaunit,,,
My sheet is really starting to rock now.
Many thanks for your time.
A very grateful
John Caines

 

[John Caines]

As a note guerillaunit,,
I've just managed to make the "Throw Your Hands Up in the Air" Font Bold also!
I added;

.Bold = True

I would like to change it's font colour also if possible,,
just searching the forums now.
I found this;
http://www.mrexcel.com/forum/showthread.php?t=475246

Cells(i, 11).Font.Color = RGB(107, 143, 0)

I changed it to;

.Color = RGB(89, 89, 89)

Hey,,It works!! I'm a coder now!! ,, well,, not really....
so,, now full blown version is as follows;

Sub CheckBox2_Click()
        If Sheets("ToDo-FULL").DrawingObjects("Check Box 2").Value > 0 Then
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Throw My Hands Up in the Air"
                .FontStyle = "Regular"
                .Color = RGB(89, 89, 89)
                .Size = 12
                .Bold = True
            End With
        End With
        Else
        With Sheets("ToDo-FULL").Range("C5:Q44")
            With .Font
                .Name = "Calibri"
                .FontStyle = "Regular"
                .Size = 12
            End With
        End With
        End If
End Sub

& very nice it is too.

Many thanks again guerillaunit

All the best
john Caines