Excel VBA中心页眉/页脚“向左对齐”

时间:2018-12-08 12:37:55

标签: excel vba excel-vba

是否可以在Excel中对齐中心页眉?我知道没有任何内置解决方案,但是有任何可以工作的VBA代码。我一直在尝试将单元格复制到标头,使用VBA设置中心标头,但我的中心标头始终都是“ Align Center”。

我什至找到了非常复杂的代码来计算句子的长度并在每行中添加空格,但实际上并不能正常工作。

我还可以设置要在顶部重复的行,而忽略页眉,但是页脚呢?如何设置居中页脚以使两行文本对齐以向左对齐?

我尝试过:

With ActiveSheet.PageSetup
    .LeftHeader = Range("a1").Value & " " & Range("b1").Value & " " & Range("a2").Value & " " & Range("b2").Value
End With

还将命名范围发送到标头:

Option Explicit

Sub SetCenterHeader()
    Dim txt As String
    Dim myRow As Range

    With Range("NorthHead") ' reference named range
        For Each myRow In .Rows ' loop through referenced range rows
            txt = txt & Join(Application.Transpose(Application.Transpose(myRow.Value)), " ") & vbLf ' update 'txt' with current row cells values joined and separated by a blank
        Next
    End With
    ActiveSheet.PageSetup.CenterHeader = Left(txt, Len(txt) - 1) ' set CenterHeader with resulting 'txt' excluding last vblf character
    ActiveWindow.SelectedSheets.PrintOut Copies:=1
End Sub

结果始终相同:

enter image description here

1 个答案:

答案 0 :(得分:1)

可以尝试以下变通办法并修改您的要求

Sub test2()
Dim CenHd1 As String, CenHd2 As String, Fname As String
Dim Rng As Range
Dim Sht As Worksheet, MnSht As Worksheet
Dim Cht As ChartObject

Set Sht = ThisWorkbook.Worksheets(3)
Set MnSht = ThisWorkbook.Worksheets(1)
Set Rng = Sht.Range("F1:F2")
CenHd1 = "Excel"
CenHd2 = "I am already left Aligned"
Sht.Range("F1").Value = CenHd1
Sht.Range("F2").Value = CenHd2
Sht.Activate
ActiveWindow.DisplayGridlines = False
    With Rng
    .Columns.AutoFit   'added after taking trial snapshot to perfectly center and left align        
    .HorizontalAlignment = xlLeft
    .Font.Name = "Bookman Old Style"
    .Font.Size = 12
    'May specify other visual effects
    End With
Rng.CopyPicture xlScreen, xlPicture

Set Cht = Sht.ChartObjects.Add(0, 0, Rng.Width * 1.01, Rng.Height * 1.01)
Cht.Name = "TmpChart"
Sht.Shapes("TmpChart").Line.Visible = msoFalse
Cht.Chart.Paste

Fname = "C:\Users\user\Desktop\CentHead " & Format(Now, "dd-mm-yy hh-mm-ss") & ".jpg"
Cht.Chart.Export Filename:=Fname, Filtername:="JPG"
DoEvents
Cht.Delete
ActiveWindow.DisplayGridlines = True

MnSht.Activate
With MnSht.PageSetup.CenterHeaderPicture
        .Filename = Fname
        '.Height = 275.25
        '.Width = 463.5
        '.Brightness = 0.36
        '.ColorType = msoPictureGrayscale
        '.Contrast = 0.39
        '.CropBottom = 0
        '.CropLeft = 0
        '.CropRight = 0
        '.CropTop = 0
    End With

'Enable the image to show up in the center header.
MnSht.PageSetup.CenterHeader = "&G"
'for Trial only
ActiveWindow.View = xlPageLayoutView
' Clear junk files
If Dir(Fname) <> "" Then Kill (Fname)
End Sub

尝试如下 enter image description here

还可以将代码修改为具有参数的函数/过程,以便在不同的工作表,工作簿等中重复使用。希望它能有助于实现这一目的。