ExecuteExcel4Macro Page.Setup Runtime Error

G

Geoff Martin

I use text boxes (1 each for Left, Center, and Right Headers and Left,
Center, and Right Footers) on a userform to get information to include
in the headers and footers of a worksheet.

I found out that headers and footers can only hold a total of only 255
characters each (at least in Excel 2000). And so I'm not sure whether
the error is generated from that (the combined number of characters in
all three header textboxes along with the number of characters in the
ExecuteExcel4Macro variable (pSetup).

Does anyone know how many characters in the ExecuteExcel4Macro apply
toward the 255 character limit so I can display a message box telling
the user to limit the character count to xxx or fewer?

Or does anyone know how to shorten this code statement (e.g., can it
be broken into two separate ExecuteExcel4Macro statements (1 for
header and 1 for footer) as a workaround for the limit? Or is there a
limit to the string length for the ExecuteExcel4Macro?

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 pSetup As String

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" & pTextLHeader & "&C&B" & pTextCHeader &
"&R&B" & pTextRHeader & """"
pFooterText = """&L&B" & pTextLFooter & "&C&06" & pTextCFooter &
"&R&B" & 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

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
Call FixReturnsInHeaders

End Sub

Sub FixReturnsInHeaders()
Dim ws As Worksheet
Dim lh As String, ch As String, rh As String
Dim lf As String, cf As String, rf As String
Dim i As Integer, tmp1 As String, tmp2 As String

Set ws = ActiveSheet



If LHeaderHasReturn Then
lh = ws.PageSetup.LeftHeader
For i = 1 To Len(lh)
If Mid$(lh, i, 2) = vbCrLf Then
tmp1 = Left$(lh, i - 1)
tmp2 = Right$(lh, Len(lh) - i - 1)
lh = tmp1 & vbLf & tmp2
ws.PageSetup.LeftHeader = lh
i = i - 1
End If
Next i
End If
If CHeaderHasReturn Then
ch = ws.PageSetup.CenterHeader
For i = 1 To Len(ch)
If Mid$(ch, i, 2) = vbCrLf Then
tmp1 = Left$(ch, i - 1)
tmp2 = Right$(ch, Len(ch) - i - 1)
ch = tmp1 & vbLf & tmp2
ws.PageSetup.CenterHeader = ch
i = i - 1
End If
Next i
End If
If RHeaderHasReturn Then
rh = ws.PageSetup.RightHeader
For i = 1 To Len(rh)
If Mid$(rh, i, 2) = vbCrLf Then
tmp1 = Left$(rh, i - 1)
tmp2 = Right$(rh, Len(rh) - i - 1)
lh = tmp1 & vbLf & tmp2
ws.PageSetup.RightHeader = rh
i = i - 1
End If
Next i
End If
If LFooterHasReturn Then
lf = ws.PageSetup.LeftFooter
For i = 1 To Len(lf)
If Mid$(lf, i, 2) = vbCrLf Then
tmp1 = Left$(lf, i - 1)
tmp2 = Right$(lf, Len(lf) - i - 1)
lf = tmp1 & vbLf & tmp2
ws.PageSetup.LeftFooter = lf
i = i - 1
End If
Next i
End If
If CFooterHasReturn Then
cf = ws.PageSetup.CenterFooter
For i = 1 To Len(cf)
If Mid$(cf, i, 2) = vbCrLf Then
tmp1 = Left$(cf, i - 1)
tmp2 = Right$(cf, Len(cf) - i - 1)
cf = tmp1 & vbLf & tmp2
ws.PageSetup.CenterFooter = cf
i = i - 1
End If
Next i
End If
If RFooterHasReturn Then
rf = ws.PageSetup.RightFooter
For i = 1 To Len(rf)
If Mid$(rf, i, 2) = vbCrLf Then
tmp1 = Left$(rf, i - 1)
tmp2 = Right$(rf, Len(rf) - i - 1)
rf = tmp1 & vbLf & tmp2
ws.PageSetup.RightFooter = rf
i = i - 1
End If
Next i
End If

End Sub
 
J

Jim Rech

I think you've sort of answered your own questions, but I was recently
wrestling with this exact problem. You have two 255 character limitations.
First, ExecuteExcel4Macro has that limitation on the length of string it can
execute. That's easily overcome by using it 2 or more times to set
different parts of the page setup. But then the overall length of the three
parts of the header or footer can be only 255 characters. This limit has
nothing to do with the way you're setting the header/footer. It's just an
Excel limitation that applies whether you're setting it by macro or
manually.

In my case I took the header and footer setting out of the
ExecuteExcel4Macro call and set them using straight VBA. Everything else I
still set with ExecuteExcel4Macro (for speed). Of course you still have to
check the overall header/footer length, but at least you don't have length
of the other parts of Page.Setup further limiting you.
 
G

Geoff Martin

Thanks, Jim, for the reply. After tinkering and troubleshooting, I think I
found something that will work with ExecuteExcel4Macro Page.Setup with long
Headers and Footers without having to go back to VBA stuff.

Here's what I came up with:

Sub PageSetup
....some code....

'************* 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:
MsgBox "It appears that you have included too many characters in your
headers or footers." & 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 Sub



Geoff Martin said:
I use text boxes (1 each for Left, Center, and Right Headers and Left,
Center, and Right Footers) on a userform to get information to include
in the headers and footers of a worksheet.

I found out that headers and footers can only hold a total of only 255
characters each (at least in Excel 2000). And so I'm not sure whether
the error is generated from that (the combined number of characters in
all three header textboxes along with the number of characters in the
ExecuteExcel4Macro variable (pSetup).

Does anyone know how many characters in the ExecuteExcel4Macro apply
toward the 255 character limit so I can display a message box telling
the user to limit the character count to xxx or fewer?

Or does anyone know how to shorten this code statement (e.g., can it
be broken into two separate ExecuteExcel4Macro statements (1 for
header and 1 for footer) as a workaround for the limit? Or is there a
limit to the string length for the ExecuteExcel4Macro?

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 pSetup As String

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" & pTextLHeader & "&C&B" & pTextCHeader &
"&R&B" & pTextRHeader & """"
pFooterText = """&L&B" & pTextLFooter & "&C&06" & pTextCFooter &
"&R&B" & 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

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
Call FixReturnsInHeaders

End Sub

Sub FixReturnsInHeaders()
Dim ws As Worksheet
Dim lh As String, ch As String, rh As String
Dim lf As String, cf As String, rf As String
Dim i As Integer, tmp1 As String, tmp2 As String

Set ws = ActiveSheet



If LHeaderHasReturn Then
lh = ws.PageSetup.LeftHeader
For i = 1 To Len(lh)
If Mid$(lh, i, 2) = vbCrLf Then
tmp1 = Left$(lh, i - 1)
tmp2 = Right$(lh, Len(lh) - i - 1)
lh = tmp1 & vbLf & tmp2
ws.PageSetup.LeftHeader = lh
i = i - 1
End If
Next i
End If
If CHeaderHasReturn Then
ch = ws.PageSetup.CenterHeader
For i = 1 To Len(ch)
If Mid$(ch, i, 2) = vbCrLf Then
tmp1 = Left$(ch, i - 1)
tmp2 = Right$(ch, Len(ch) - i - 1)
ch = tmp1 & vbLf & tmp2
ws.PageSetup.CenterHeader = ch
i = i - 1
End If
Next i
End If
If RHeaderHasReturn Then
rh = ws.PageSetup.RightHeader
For i = 1 To Len(rh)
If Mid$(rh, i, 2) = vbCrLf Then
tmp1 = Left$(rh, i - 1)
tmp2 = Right$(rh, Len(rh) - i - 1)
lh = tmp1 & vbLf & tmp2
ws.PageSetup.RightHeader = rh
i = i - 1
End If
Next i
End If
If LFooterHasReturn Then
lf = ws.PageSetup.LeftFooter
For i = 1 To Len(lf)
If Mid$(lf, i, 2) = vbCrLf Then
tmp1 = Left$(lf, i - 1)
tmp2 = Right$(lf, Len(lf) - i - 1)
lf = tmp1 & vbLf & tmp2
ws.PageSetup.LeftFooter = lf
i = i - 1
End If
Next i
End If
If CFooterHasReturn Then
cf = ws.PageSetup.CenterFooter
For i = 1 To Len(cf)
If Mid$(cf, i, 2) = vbCrLf Then
tmp1 = Left$(cf, i - 1)
tmp2 = Right$(cf, Len(cf) - i - 1)
cf = tmp1 & vbLf & tmp2
ws.PageSetup.CenterFooter = cf
i = i - 1
End If
Next i
End If
If RFooterHasReturn Then
rf = ws.PageSetup.RightFooter
For i = 1 To Len(rf)
If Mid$(rf, i, 2) = vbCrLf Then
tmp1 = Left$(rf, i - 1)
tmp2 = Right$(rf, Len(rf) - i - 1)
rf = tmp1 & vbLf & tmp2
ws.PageSetup.RightFooter = rf
i = i - 1
End If
Next i
End If

End Sub
Click to expand...
 

Ask a Question

Want to reply to this thread or ask your own question?

You'll need to choose a username for the site, which only take a couple of moments. After that, you can post your question and our members will help you out.

Ask a Question

Similar Threads

Apply a Font using Page.Setup and ExecuteExcel4Macro 1
ExecuteExcel4Macro 4
ExecuteExcel4Macro Error 2
Type Mismatch 0
PS4 Pagesetup, pscale as array 1
Remove duplicate values from String Arrays 4
changing footer before save 4
"run-time error '1004' - select method of range failed" 2

Top