Solved

VBA: Align text to left in right Excel page header

Posted on 2008-10-30
10
4,838 Views
Last Modified: 2016-08-26
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

0
Comment
Question by:bishop3000
  • 5
  • 4
10 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
Comment Utility
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
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
Comment Utility
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
 

Author Comment

by:bishop3000
Comment Utility
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
 

Author Comment

by:bishop3000
Comment Utility
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
 

Author Comment

by:bishop3000
Comment Utility
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
How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 500 total points
Comment Utility
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
 

Author Comment

by:bishop3000
Comment Utility
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
 

Author Comment

by:bishop3000
Comment Utility
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
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
Comment Utility
Ah, the non-breaking space is good for something after all!

Glad you sorted it out.

Kevin
0
 

Expert Comment

by:Jean-Paul ROCHE
Comment Utility
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

Featured Post

Better Security Awareness With Threat Intelligence

See how one of the leading financial services organizations uses Recorded Future as part of a holistic threat intelligence program to promote security awareness and proactively and efficiently identify threats.

Join & Write a Comment

This is pretty cool.  The purpose of this VB Script is to help you document where JAR (Java ARchive) files and specifically java class files are located so that you can address issues seen with a client or that you can speak intelligently with a dev…
Workbook link problems after copying tabs to a new workbook? David Miller (dlmille) Intro Have you either copied sheets to a new workbook, and after having saved and opened that workbook, you find that there are links back to the original sou…
The viewer will learn how to use the =DISCRINV command to create a discrete random variable, use this command to model a set of probabilities and outcomes in a Monte Carlo simulation, and learn how to find the standard deviation of a set of probabil…
This Micro Tutorial will demonstrate on a Mac how to change the sort order for chart legend values and decrpyt the intimidating chart menu.

763 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

6 Experts available now in Live!

Get 1:1 Help Now