Верхний / нижний колонтитул Excel VBA Center «Выровнять по левому краю» - PullRequest
0 голосов
/ 08 декабря 2018

Есть ли способ выровнять центральный заголовок в Excel?Я знаю, что нет никакого встроенного решения, но есть ли код VBA, который будет работать.Я пытался скопировать ячейки в заголовок, устанавливая центральный заголовок с помощью VBA, но мой центральный заголовок все время "Align Center".

Я даже нашел очень сложный код для вычисления длины предложений и добавления пробелов к каждой строке, но он на самом деле не работает правильно.

Я также могу задать повторение строк сверху и забыть о заголовке, но как насчет нижнего колонтитула?Как настроить Center Footer для выравнивания текста в две строки по левому краю?

Я пытался:

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 голосов
/ 09 декабря 2018

Можно попробовать следующий обходной путь и изменить его в соответствии с вашими требованиями

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

код также можно изменить как функцию /процедура с параметрами для повторного использования с различными листами, рабочими тетрадями и т. д. Надеюсь, что это поможет служить цели.

Добро пожаловать на сайт PullRequest, где вы можете задавать вопросы и получать ответы от других членов сообщества.
...