Solved

VBA: Align text to left in right Excel page header

Posted on 2008-10-30
10
5,426 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
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 5
  • 4
10 Comments
 
LVL 81

Expert Comment

by:zorvek (Kevin Jones)
ID: 22848034
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)
ID: 22848045
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
ID: 22852055
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
Online Training Solution

Drastically shorten your training time with WalkMe's advanced online training solution that Guides your trainees to action. Forget about retraining and skyrocket knowledge retention rates.

 

Author Comment

by:bishop3000
ID: 22852616
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
ID: 22854874
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
 
LVL 81

Accepted Solution

by:
zorvek (Kevin Jones) earned 500 total points
ID: 22856174
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
ID: 22863639
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
ID: 22901059
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)
ID: 22901549
Ah, the non-breaking space is good for something after all!

Glad you sorted it out.

Kevin
0
 

Expert Comment

by:Jean-Paul ROCHE
ID: 41772445
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

On Demand Webinar - Networking for the Cloud Era

This webinar discusses:
-Common barriers companies experience when moving to the cloud
-How SD-WAN changes the way we look at networks
-Best practices customers should employ moving forward with cloud migration
-What happens behind the scenes of SteelConnect’s one-click button

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Some code to ensure data integrity when using macros within Excel. Also included code that helps secure your data within an Excel workbook.
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
The viewer will learn how to create a normally distributed random variable in Excel, use a normal distribution to simulate the return on an investment over a period of years, Create a Monte Carlo simulation using a normal random variable, and calcul…
This Micro Tutorial will demonstrate how to use longer labels with horizontal bar charts instead of the vertical column chart.

632 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