Excel标题宏最多可达3行

时间:2013-11-08 18:52:38

标签: excel vba excel-vba

此宏用于为工作簿中的所有工作表设置四行左标题。这个宏的要点是控制每一行的字体大小,属性即粗体。我有一个名为header的单独表单,其中包含我使用的值。它适用于3行,但是当我添加第4行时,它就会出错。 我收到这个错误。 运行时错误'1004': 无法设置PageSetup类的LeftHeader属性

另请注意,我正在运行Excel 2010 64位。

Sub Header()
    '
    ' Header Macro
    '
    lHeader = "&""Calibri,Regular""&10" & Worksheets("Header").Range("B2").Value
    lHeader = lHeader & Chr(13) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B3").Value
    lHeader = lHeader & Chr(13) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B4").Value
    lHeader = lHeader & Chr(13) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B5").Value

    Dim Naam As String, NameFile() As String
    ReDim NameFile(1 To Sheets.Count)

    With Application
        .ScreenUpdating = False
        i = 1
        For Each shtNext In Sheets
            With Sheets(i).PageSetup
                .LeftHeader = lHeader

                .LeftFooter = Format(Now, "mmmm d, yyyy")

                .CenterFooter = "&""Calibri,Regular""&10" & Format(Worksheets("Header").Range("C8").Value)

                .RightFooter = "&""Calibri,Regular""&10" & Format(Worksheets("Header").Range("D8").Value) & "&p of &N"
            End With
            i = i + 1
        Next shtNext
    End With
End Sub

2 个答案:

答案 0 :(得分:1)

您收到该错误是因为超过了255个字符的限制。不幸的是,我找不到一篇MSDN文章来支持它,但它可以很容易地重新制作。

您拥有的当前长度是

HeaderL - 121 
HeaderC - 112
HeaderR - 121

Total   - 354

试试这段代码。在这里,您可以通过实验来减少角色。

Sub Header()
    HeaderL = "&""Calibri,Regular""&10" & Worksheets("Header").Range("B2").Value
    HeaderL = HeaderL & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B3").Value
    HeaderL = HeaderL & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B4").Value
    HeaderL = HeaderL & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("B5").Value

    HeaderC = "&""Calibri,Bold""&14" & Worksheets("Header").Range("C2").Value
    HeaderC = HeaderC & Chr(10) & "&""Calibri,Bold""&14" & Worksheets("Header").Range("C3").Value
    HeaderC = HeaderC & Chr(10) & "&""Calibri,Bold""&14" & Worksheets("Header").Range("C4").Value
    HeaderC = HeaderC & Chr(10) & "&""Calibri,Regular""&14" & Worksheets("Header").Range("B5").Value

    HeaderR = "&""Calibri,Regular""&10" & Worksheets("Header").Range("D2").Value
    HeaderR = HeaderR & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("D3").Value
    HeaderR = HeaderR & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("D4").Value
    HeaderR = HeaderR & Chr(10) & "&""Calibri,Regular""&10" & Worksheets("Header").Range("D5").Value

    If Len(HeaderL) + Len(HeaderC) + Len(HeaderR) > 255 Then
        MsgBox "Oops, You have exceeded the character limit. Please reduce it and try again"
        Exit Sub
    End If

    Dim ws As WorkSheet

    Application.ScreenUpdating = False

    For Each ws In ThisWorkbook.Sheets
        With ws.PageSetup
            .LeftHeader = HeaderL

            .CenterHeader = HeaderC

            .RightHeader = HeaderR

            .LeftFooter = Format(Now, "mmmm d, yyyy")

            .CenterFooter = "&""Calibri,Regular""&10" & Format(Worksheets("Header").Range("C8").Value)

            .RightFooter = "&""Calibri,Regular""&10" & Format(Worksheets("Header").Range("D8").Value) & "&p of &N"
        End With
    Next ws

    Application.ScreenUpdating = True
End Sub

答案 1 :(得分:0)

即使分离宏,255个字符的限制也是真实的。字体值占总数的很大一部分。所以我删除了所有execpt的最后一行。但是如果我需要一个具有不同字体大小的报告。我有一点摆动空间来改变2条线而不会变得太大。

LHeader = Worksheets("Header").Range("B2").Value
LHeader = LHeader & Chr(10) & Worksheets("Header").Range("B3").Value
LHeader = LHeader & Chr(10) & Worksheets("Header").Range("B4").Value
LHeader = "&""Calibri,Regular""&10" & LHeader & Chr(10) & Worksheets("Header").Range("B5").Value

CHeader = Worksheets("Header").Range("C2").Value
CHeader = CHeader & Chr(10) & Worksheets("Header").Range("C3").Value
CHeader = CHeader & Chr(10) & Worksheets("Header").Range("C4").Value
CHeader = "&""Calibri,Bold""&14" & CHeader & Chr(10) & Worksheets("Header").Range("B5").Value


RHeader = Worksheets("Header").Range("D2").Value
RHeader = RHeader & Chr(10) & Worksheets("Header").Range("D3").Value
RHeader = RHeader & Chr(10) & Worksheets("Header").Range("D4").Value
RHeader = "&""Calibri,Regular""&10" & RHeader & Chr(10) & Worksheets("Header").Range("D5").Value