VBA: Align text to left in right Excel page header

Hello,
I'm trying to align text to the left within the right header

With use of vbCR it will be

Name
Company Name
Number
Address

It looks silly with the default right alignment.

In Excel, the alignment options are grayed out in header set-up.

I've tried: .RightHeader = "&L" & "Michael Bishop" & vbCr &..."
-That puts in the left header.

If there's no direct solution, perhaps there's a tricky round-about solution?
Either would be greatly appreciated.

Thanks,
Michael

bishop3000Asked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

zorvek (Kevin Jones)ConsultantCommented:
You don't have any control over the justification of the header and footer components. All you can do is insert spaces on the end of the header to shift it to the left.

Kevin
0
zorvek (Kevin Jones)ConsultantCommented:
If your printout is only a page or two, you can use cells on the worksheet instead of the pager footer to format a footer more to your liking.

Kevin
0
bishop3000Author Commented:
Hi Kevin,
The printout will be up to 100 pages so I'll need an actual header.

Strangely, adding spaces to the right of the text doesn't register if vbCr is used (and I need multiple lines in the header).

So .RightHeader =  "Alf         " shows up as "Alf         "
 .RightHeader =  "Alf         " & vbCr &..."  shows up as "Alf"

In Excel 2007, I can put a white-colored period at the end of the spacing. Alas, I can't figure out how to make the period white in Excel 2003 (which this needs to work on). Worse comes to worse, Excel 2003 users will see a lone period.

Any ideas how to avoid the black period in Excel 2003?

Thanks,
Michael
0
Cloud Class® Course: Microsoft Windows 7 Basic

This introductory course to Windows 7 environment will teach you about working with the Windows operating system. You will learn about basic functions including start menu; the desktop; managing files, folders, and libraries.

bishop3000Author Commented:
Furthermore, adding spaces to the right doesn't work very well because different characters have different widths (I figured that out in the attached code).

I'm going to try accounting for pixel width of each character...this code will get pretty cumbersome though. Better solutions would be appreciated.

Thanks,
Michael
Sub ShowPrintPreview()
 
Dim Name As String, Company As String, Number As String, Address As String
Dim Cnt1 As Integer, Cnt2 As Integer, Cnt3 As Integer, Cnt4 As Integer
Dim MaxCnt As Integer
Dim Spacing1 As Integer, Spacing2 As Integer, Spacing3 As Integer, Spacing4 
Dim Line1 As String, Line2 As String, Line3 As String, Line4 As String
 
Name = "Michael Bishop"
Company = "Tyrannosaurus Rex"
Number = "831.234.7076"
Address = "PO Box 231, Ben Lomond, CA 95005"
 
Cnt1 = Len(Name)
Cnt2 = Len(Company)
Cnt3 = Len(Number)
Cnt4 = Len(Address)
 
MaxCnt = Application.Max(Cnt1, Cnt2, Cnt3, Cnt4)
 
Spacing1 = MaxCnt - Cnt1
Spacing2 = MaxCnt - Cnt2
Spacing3 = MaxCnt - Cnt3
Spacing4 = MaxCnt - Cnt4
 
Line1 = Name & Application.Rept(" ", Spacing1) & "."
Line2 = Company & Application.Rept(" ", Spacing2) & "."
Line3 = Number & Application.Rept(" ", Spacing3) & "."
Line4 = Address & Application.Rept(" ", Spacing4) & "."
 
Lines = Line1 & vbCr & Line2 & vbCr & Line3 & vbCr & Line4
 
With ActiveSheet.PageSetup
  .PrintArea = Range("A1:J54")
  .RightHeader = Lines
End With
 
ActiveSheet.PrintPreview enablechanges:=False
 
End Sub

Open in new window

0
bishop3000Author Commented:
I've been working on a fix for this for too long--using width ratios for each character to determine the number of spaces to put at the end of each line so all lines are left-aligned.

It's behaving strange. I can't figure it out. Please check out the module titled 'LookAtThisModule'. Type different things in TextArray(0,0). Then run it for the print preview. Why doesn't it align as it should??

Please! help me figure out why this is bugging. I imagine the ultimate function (which allows left-alignment in the right header) will be useful for many people.

Thank you thank you,
Michael
Header-Test.xls
0
zorvek (Kevin Jones)ConsultantCommented:
Michael,

Please consider that you may be solving a problem that doesn't exist. Has the user insisted that the information be displayed in the header as you are trying to do? Or are you doing this because you feel it is the right thing to do? If the latter then I challenge you to reconsider your quest. What you are trying to do is a difficult, if not impossible task, and the results may only be appreciated by you. I really don't think you will ever get the text to align with any real accuracy using filler characters.

Does the text really have to be left aligned? Can the text be displayed in the left header? Who wants it this way?

That said, I did come up with something that, while being a hack, might work well enough for you to wrap this up and move on to other tasks. There is a way to save a block of cells as an image in a file. It involves a little trickery but I managed to use it to create an image that provides what you are looking for when copied into the worksheet's header. The resulting text is not quite as crisp as if the text was placed directly in the header, but considering what you are going through to get this to work, perhaps this will be good enough.

I have attached your workbook with the code installed. See the general code module Zorvek. Below is the code I wrote.

Public Sub CreateHeader()
   
    Dim FilePathName As String
    Dim TemporaryWorksheet As Worksheet
    Dim TemporaryChart As Chart
    Dim TemporaryPicture As Picture
   
    Application.ScreenUpdating = False
   
    'Add a temporary worksheet
    Set TemporaryWorksheet = Worksheets.Add
   
    'Add a chart
    Charts.Add
   
    ActiveChart.Location Where:=xlLocationAsObject, Name:=TemporaryWorksheet.Name
   
    Set TemporaryChart = ActiveChart
   
    TemporaryChart.ChartArea.Border.LineStyle = xlNone
    DoEvents
   
    ' Copying range
    ThisWorkbook.Sheets("Zorvek").Range("A1:A4").CopyPicture Appearance:=xlScreen, Format:=xlPicture
   
    DoEvents
   
    'Paste the image over the chart
    TemporaryChart.Paste
   
    Set TemporaryPicture = Selection
   
    ' Placing some extra space around the image
    With TemporaryChart.Parent
        .Width = TemporaryPicture.Width + 1
        .Height = TemporaryPicture.Height + 1
    End With
   
    FilePathName = ThisWorkbook.Path & "\Temp Header Image.gif"
   
    TemporaryChart.Export Filename:=FilePathName, FilterName:="gif"
   
    Application.DisplayAlerts = False
    TemporaryWorksheet.Delete
    Application.DisplayAlerts = True
   
    With ThisWorkbook.Sheets("LookAtThisSheet").PageSetup
        .RightHeaderPicture.Filename = FilePathName
        .RightHeader = "&G"
    End With
   
    Kill FilePathName

End Sub

Kevin
Header-Test.xls
0

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
bishop3000Author Commented:
Hi Kevin,

It's so comforting to know you're out there.

Yes, this does seem a lot more trivial than I've made it out to be. I'm hopelessly obstinate, but also headers make a lot of sense for my particular situation.

I hadn't thought of turning the header text into an image . Alas, the quality isn't quite sufficient for my people. Your code showed me how to incorporate a graphic into the header (we talked about this a few days ago)--something I'll definitely be applying now that I know how.

I figured out what I think is the best possible solution for my alignment issue (see the code snippet or the attached workbook).

You're right that it will never be perfect given printer driver (it looks perfect in the page layout view though). For this, I'll allow the user to add spaces to the right of particular lines in a header-setup userform.

The only thing I have trouble with is making the line ending "." white (invisible) in Excel 2007. I'm close though (see the code). An answer here would be appreciated.

I'm giving you the points because you gave me a solution.
Can't thank you enough,
Michael






Sub AddRightHeader()
 
Dim HeaderArray()
Dim HeaderFont As String, HeaderText As String
 
ReDim HeaderArray(0 To 5, 0 To 1)
 
HeaderArray(0, 0) = "Alexander Farzakarak"
HeaderArray(1, 0) = "Some Company"
HeaderArray(2, 0) = "Chief Man"
HeaderArray(3, 0) = "800.234.5678"
HeaderArray(4, 0) = "PO Box 123, Jackson Mt, PN  45678"
 
HeaderFont = "Arial"
 
HeaderArray = GetLeftAlignSpacing(HeaderArray, HeaderFont)
 
HeaderText = ""
For i = 0 To 4
  HeaderText = HeaderText & HeaderArray(i, 0) & WorksheetFunction.Rept(" ", HeaderArray(i, 1))
    If Application.Version >= 12 Then
      HeaderText = HeaderText & "." ' "&K00+000.&K01+000"
    Else
      HeaderText = HeaderText & "."
    End If
  If i < UBound(HeaderArray) Then HeaderText = HeaderText & vbCr
Next i
 
' HeaderText = "Jack    " & "&K00+000.&K01+000" & vbCr & "Jane        " & "&K00+000.&K01+000"  ' This works in Excel 2007
 
For i = 0 To 4
With ActiveSheet.PageSetup
  .RightHeader = HeaderText
End With
Next i
 
'ActiveSheet.PrintPreview enablechanges:=False
 
End Sub
 
 
 
Function GetLeftAlignSpacing(HeaderArray, HeaderFont As String)
 
Dim TempSheet As Worksheet
Dim MaxBoxWidth As Single, LineItem As String, SpacesToRight As Integer
 
Application.ScreenUpdating = False
 
Sheets.Add
Set TempSheet = ActiveSheet
TempSheet.Range("A1").Font.Name = HeaderFont
 
MaxBoxWidth = 0
For i = 0 To 4
  TempSheet.Range("A1").Value = HeaderArray(i, 0)
  TempSheet.Columns(1).AutoFit
  If TempSheet.Columns(1).ColumnWidth > MaxBoxWidth Then MaxBoxWidth = TempSheet.Columns(1).ColumnWidth
Next i
       
For i = 0 To 4
SpacesToRight = 0: LineItem = ""
  Do While Columns(1).ColumnWidth <= MaxBoxWidth
    SpacesToRight = SpacesToRight + 1
      LineItem = HeaderArray(i, 0) & WorksheetFunction.Rept(" ", SpacesToRight)
      Range("A1").Value = LineItem
      TempSheet.Columns(1).AutoFit
  Loop
HeaderArray(i, 1) = SpacesToRight - 1
Range("A1").Value = ".": TempSheet.Columns(1).AutoFit
Next i
 
Application.DisplayAlerts = False
  TempSheet.Delete
Application.DisplayAlerts = True
 
GetLeftAlignSpacing = HeaderArray
 
Application.ScreenUpdating = True
 
End Function

Open in new window

AutoAlignedRightHeader.xls
0
bishop3000Author Commented:
If anyone stumbles on this later, use chr(160) instead of " "--no longer need the ending period.
The final code works great...well worth the effort.
0
zorvek (Kevin Jones)ConsultantCommented:
Ah, the non-breaking space is good for something after all!

Glad you sorted it out.

Kevin
0
Jean-Paul ROCHECommented:
Hello,
Thank you for sharing code
I used the latest code and have an alignment problem of the header
The first and last line are aligned left but the other three lines are shifted to the left
If someone has a correction code
Greetings
Jean Paul
0
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
VB Script

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.