[mso] Re: proportional sizing of fonts

Hi Errol,
Yep there sure is.

I'm not sure where I got this from, but here's a macro you can use.

Just assign it to a keystroke and it's easy to use:

Public Sub MAIN()
Dim Num
Dim Pointsize$
Dim Points
Dim Increment
    Num =3D WordBasic.FontSize()
    Dim Track As Object: Set Track =3D
WordBasic.DialogRecord.FormatFont(False)
    WordBasic.CurValues.FormatFont Track
    Pointsize$ =3D Track.Points
    Points =3D WordBasic.Val(Pointsize$)
    Increment =3D 1
    If Increment < 0.5 Then
        Increment =3D 0.5
    ElseIf Increment < 1 Then
        Increment =3D 1
    End If
    WordBasic.FormatFont Points:=3DPoints + Increment
End Sub


The matching decrease font size macro is:

Public Sub MAIN()
Dim Pointsize$
Dim Points
Dim Increment
    Dim Track As Object: Set Track =3D
WordBasic.DialogRecord.FormatFont(False)
    WordBasic.CurValues.FormatFont Track
    Pointsize$ =3D Track.Points
    Points =3D WordBasic.Val(Pointsize$)
    Increment =3D 1
    If Points <=3D 1.5 Then
        Increment =3D 0
    End If
    WordBasic.FormatFont Points:=3DPoints - Increment

End Sub


Hope that helps


____________________________________
,,,,,   Neil Atwood - natwood@xxxxxxxxxxxxxxxxxx=20
=D4=BF=D4=AC    Sydney, Australia=20


=20



        :-----Original Message-----
        :From: mso-bounce@xxxxxxxxxxxxx=20
        :[mailto:mso-bounce@xxxxxxxxxxxxx] On Behalf Of Errol Sapir
        :Sent: Thursday, 2 May 2002 7:59 AM
        :To: mso@xxxxxxxxxxxxx
        :Subject: [mso] proportional sizing of fonts
        :
        :
        :
        :In word is there a way of choosing a whole document=20
        :(cntrl & A) and then making the=20
        :whole document resize proportionally - i.e. every font=20
        :go up (or down) one size?
        :Errol
        :*************************************************************
        :PLEASE READ!!!!
        :
        :This is not S*P*A*M!  You are receiving this mail=20
        :because you either subscribed to mso@xxxxxxxxxxxxx or=20
        :to it's earlier version, MicrosoftOffice@xxxxxxxxxxxxxxxx
        :
        :To Unsubscribe from this group, send an email to=20
        :mso-request@xxxxxxxxxxxxx with a subject line that=20
        :says "unsubscribe" (without the quotes).  Do not put=20
        :unsubscribe IN CAPS.  Screaming doesn't get you out=20
        :any faster and the caps prevent the function from working.
        :
        :To change your email settings to digest or vacation=20
        :(no mail), visit the group's homepage for full instructions.
        :
        :http://www.freelists.org/webpage/mso
        :*************************************************************
        :

*************************************************************
PLEASE READ!!!!

This is not S*P*A*M!  You are receiving this mail because you either subscribed 
to mso@xxxxxxxxxxxxx or to it's earlier version, 
MicrosoftOffice@xxxxxxxxxxxxxxxx

To Unsubscribe from this group, send an email to mso-request@xxxxxxxxxxxxx with 
a subject line that says "unsubscribe" (without the quotes).  Do not put 
unsubscribe IN CAPS.  Screaming doesn't get you out any faster and the caps 
prevent the function from working.

To change your email settings to digest or vacation (no mail), visit the 
group's homepage for full instructions.

http://www.freelists.org/webpage/mso
*************************************************************

Other related posts: