View Single Post
  #1 (permalink)  
Old December 2nd, 2005, 12:29 PM
tonyrosen tonyrosen is offline
Authorized User
Join Date: Nov 2005
Location: Houston, TX, .
Posts: 16
Thanks: 0
Thanked 1 Time in 1 Post
Send a message via Yahoo to tonyrosen
Default Tab Order Screwy

Okay, first I used this code to "resize" my merged cells:


Sub AutoFitMergedCells(Target As Range)
     'AutoFits a merged cell range, even though it is technically impossible
    Dim MergedWidth As Double, NewHeight As Double, ReqdHeight As Double
    Dim cel As Range, celTemp As Range, col As Range, colCopy As Range, rg As Range, rw As Range
    Dim Mergers As New Collection
    Dim i As Long, nMerge As Long, nRow As Long
    Set rg = Target.Cells(1, 1)
    If Not rg.MergeCells Then Exit Sub
    Application.ScreenUpdating = False
     'Identify all the merged ranges in this row
    nRow = rg.Row
    With Target.Parent 'The worksheet containing the range Target
        For i = 1 To 256
            If .Cells(nRow, i).MergeCells And .Cells(nRow, i).WrapText Then
                nMerge = nMerge + 1
                Mergers.Add Item:=.Cells(nRow, i).MergeArea
                i = i + .Cells(nRow, i).MergeArea.Columns.Count - 1
            End If
        Set colCopy = .Columns(256) '.Insert 'Insert an empty column
        Set celTemp = colCopy.Cells(nRow, 1)
    End With
    For i = 1 To nMerge 'Loop through all the merged areas on this row
        Set rg = Mergers(i)
        With rg
            MergedWidth = 0
            Set cel = .Cells(1, 1)
            For Each col In .Columns
                MergedWidth = col.Width + MergedWidth 'Measured in points
            Next col

            .MergeCells = False
            colCopy.ColumnWidth = 0.1905 * MergedWidth - 0.7139 'Convert from points to "characters"
            celTemp.PasteSpecial xlPasteValues
            celTemp.PasteSpecial xlPasteFormats
            .MergeCells = True


             'For some reason, celTemp.EntireRow.Height changes when .MergeCells=True
            If celTemp.EntireRow.Height > ReqdHeight Then ReqdHeight = celTemp.EntireRow.Height
        End With
    i = Target.Parent.UsedRange.Rows.Count
    Target.RowHeight = Application.Max(ReqdHeight / Target.Rows.Count + 0.49, 12.75) 'Round row height up to 0.5 points, minimum of 12.75 points
    If ReqdHeight >= 409.5 Then MsgBox "Warning! Text is truncated because maximum merged cell height is 409.5 points"
    Application.ScreenUpdating = True
End Sub

Then, we decided to "skip" empty field validation because after using it they believed me when I said it would be annoying. That being said, I had to find something for "tabbing" to the next field - and came across this piece of code in this forum.

In my 'Worksheet_SelectionChange" section I put:


Dim TabOrder As Variant, X As Variant
Dim addr As String
Dim rg As Range, targ As Range
If TabOrderFlag = True Then Exit Sub

TabOrder = Array("Range1", "Range2", "Range3", "Range4", "Range5", "Range8", "Range9", "Range10", "Range11", "Range12", "Range13", "Range14", "Range14a", "Range14b", "Range14c", "Range14d", "Range15") 'List your cell addresses in desired tab order here
For Each X In TabOrder
    If rg Is Nothing Then
        Set rg = Range(X)
        Set rg = Union(rg, Range(X))
    End If

Set targ = Intersect(rg, Target)
If targ Is Nothing Then
    addr = Target.Cells(1, 1).Address(ColumnAbsolute:=False, RowAbsolute:=False)
    X = Application.Match(addr, TabOrder, 0)
    If IsError(X) Then Range(TabOrder(LBound(TabOrder))).Activate
End If

Then, in a module I had to put this:


Public TabOrderFlag As Boolean

Sub TabOrderMode()
    TabOrderFlag = Not TabOrderFlag
End Sub

Now, my problem. The Auto Size Merged Cells code messes up the tab order. Whenever you place a piece of text in a cell, the Auto Size piece kicks in and then messes up the works.

Any ideas?

Reply With Quote