Apply a Font using Page.Setup and ExecuteExcel4Macro

[Geoff Martin]

I'd like to make the font for the Header and Footer Times New Roman or
Garamond using the Page.Setup excel 4 macro. The code's below, but I can't
seem to figure out where or how to put the command to change the font. The
Macrofun.hlp file is a bit vague as to where and how to do it in code like
the following.

thanks much,
Geoff

Code:
Sub PageSetup(Optional pTextLHeader As String, Optional pTextCHeader As
String, Optional pTextRHeader As String, Optional pTextLFooter As String,
Optional pTextCFooter As String, Optional pTextRFooter As String) ',
Optional pCellGridlines As Boolean)

Dim pHeaderText As String, pFooterText As String
Dim pMarginLeft As String, pMarginRight As String, pMarginHead As
String, pMarginFoot As String
Dim pMarginTop As String, pMarginBottom As String
Dim pRowColHeadings As Boolean, pCellComments As Boolean, pCellGridlines
As Boolean
Dim pQuality As String, pCenterHorizontally As Boolean,
pCenterVertically As Boolean
Dim pOrientation As Integer, pDraft As Boolean, pPaperSize As Integer,
pPageNumber As String
Dim pPageOrder As String, pBWCells As Boolean, pScale As String

Dim hLen As Long, fLen As Long

Dim pSetup As Variant

If pTextLHeader = "" Then pTextLHeader = "Skill Description"
If pTextCHeader = "" Then pTextCHeader = "Practice Sheet"
If pTextRHeader = "[Sheet]" Or pTextRHeader = "" Then pTextRHeader =
"&A"

If pTextLFooter = "" Then pTextLFooter = "Aim: "
If pTextCFooter = "" Then
pTextCFooter = " "
ElseIf IsNumeric(Left(pTextCFooter, 1)) Then
pTextCFooter = " " & pTextCFooter
End If
If pTextRFooter = "Page [x] of [y]" Then pTextRFooter = "Page &P of &N"

pHeaderText = """&L&B&08" & pTextLHeader & "&C&B&08" & pTextCHeader &
"&R&B&08" & pTextRHeader & """"
pFooterText = """&L&B&08" & pTextLFooter & "&C&06" & pTextCFooter &
"&R&B&08" & pTextRFooter & """"
pMarginLeft = 0.5
pMarginRight = 0.5
pMarginTop = 1
pMarginBottom = 0.75
pMarginHead = 0.65
pMarginFoot = 0.5
pRowColHeadings = False
pCellGridlines = False
pCellComments = False
pQuality = ""
pCenterHorizontally = True
pCenterVertically = True
pOrientation = 2
pDraft = False
pPaperSize = 1
pPageNumber = """Auto"""
pPageOrder = 1
pBWCells = False
pScale = 100
'************* OLD CODE THAT GENERATED AN ERROR WHEN STRING pSetup WAS
TOO LONG ***********************
' pSetup = "PAGE.SETUP(" & pHeaderText & "," & pFooterText & "," &
pMarginLeft & "," & pMarginRight & ","
' pSetup = pSetup & pMarginTop & "," & pMarginBottom & "," &
pRowColHeadings & "," & pCellGridlines & "," & pCenterHorizontally & ","
' pSetup = pSetup & pCenterVertically & "," & pOrientation & "," &
pPaperSize & "," & pScale & ","
' pSetup = pSetup & pPageNumber & "," & pPageOrder & "," & pBWCells &
"," & pQuality & ","
' pSetup = pSetup & pMarginHead & "," & pMarginFoot & "," &
pCellComments & "," & pDraft & ")"
'
' Application.ExecuteExcel4Macro pSetup

'***************************************************************************
***************************



'***************************************************************************
******************************************
'***************NEW CODE THAT BREAKS pSetup INTO 3 DIFFERENT STATEMENTS,
EACH EXECUTED SEPARATELY ********************
On Error GoTo Whoops
pSetup = "PAGE.SETUP(" & pHeaderText & ",,,,,,,,,,,,,,,,,,,)"
Application.ExecuteExcel4Macro pSetup 'Breaks page setup into 3 parts
to solve the Runtime 1004 error with too many characters

pSetup = "PAGE.SETUP(," & pFooterText & ",,,,,,,,,,,,,,,,,,,)"
Application.ExecuteExcel4Macro pSetup 'Breaks page setup into 3 parts
to solve the Runtime 1004 error with too many characters


pSetup = "PAGE.SETUP(,," & pMarginLeft & "," & pMarginRight & "," &
pMarginTop & "," & pMarginBottom & "," & pRowColHeadings & "," &
pCellGridlines & "," & pCenterHorizontally & "," & pCenterVertically & "," &
pOrientation & "," & pPaperSize & "," & pScale & "," & pPageNumber & "," &
pPageOrder & "," & pBWCells & "," & pQuality & "," & pMarginHead & "," &
pMarginFoot & "," & pCellComments & "," & pDraft & ")"
Application.ExecuteExcel4Macro pSetup 'Breaks page setup into 3 parts
to solve the Runtime 1004 error with too many characters

On Error GoTo 0

Call FixReturnsInHeaders

Exit Sub

Whoops:
'Dim hLen As Long
hLen = Len(frmCreatePracticeSheet.txtLHeader) +
Len(frmCreatePracticeSheet.txtCHeader) +
Len(frmCreatePracticeSheet.txtRHeader)
' If hfLen > 200 Then
' MsgBox "The total number of characters for all headers must be
less than 200. You have " & hfLen & " characters." & vbCrLf & "Please reduce
some of the headers.", vbOKOnly + vbInformation, "Too many characters in
headers"
' Exit Sub
' End If

fLen = Len(frmCreatePracticeSheet.txtLFooter) +
Len(frmCreatePracticeSheet.txtCFooter) +
Len(frmCreatePracticeSheet.txtRFooter)
' If hfLen > 200 Then
' MsgBox "The total number of characters for all footers must be
less than 200. You have " & hfLen & " characters." & vbCrLf & "Please reduce
some of the footers.", vbOKOnly + vbInformation, "Too many characters in
footers"
' Exit Sub
' End If
'This catches errors that the limit of 200 msgbox didn't catch
MsgBox "It appears that you have too many characters in your headers ("
& hLen & " characters) or footers (" & fLen & " characters)." & vbCrLf & _
"Reduce the number of characters to avoid this problem.",
vbCritical + vbOKOnly, "Too many characters in header or footer"


Application.DisplayAlerts = False
ActiveSheet.Delete 'deletes the sheet and allow user to edit the
header/footers
Application.DisplayAlerts = True
On Error GoTo 0

frmCreatePracticeSheet.Show
End 'Terminates code

End Sub

 

[Jim Cone]

Geoff,

I think you posted too much strange code and may have scared people off.
So for what its worth, the formatting codes for XL4 and later versions of
Excel appear to be the same. The following may be what would work:

dim WordToUse as String
WordToUse = "Never Upgrade"
WordToUse = "&""ChevaraOutline,&B""&20" & WordToUse

The above changes the font in the variable WordToUse to ChevaraOutline,
makes it bold and makes the font size 20.

Hope this helps.

Regards,
Jim Cone
San Francisco, CA

I'd like to make the font for the Header and Footer Times New Roman or
Garamond using the Page.Setup excel 4 macro. The code's below, but I can't
seem to figure out where or how to put the command to change the font. The
Macrofun.hlp file is a bit vague as to where and how to do it in code like
the following.

thanks much,
Geoff

- snip -