Wrox Programmer Forums

Need to download code?

View our list of code downloads.

Go Back   Wrox Programmer Forums > Microsoft Office > Excel VBA > Excel VBA
Password Reminder
Register
| FAQ | Members List | Search | Today's Posts | Mark Forums Read
Excel VBA Discuss using VBA for Excel programming.
Welcome to the p2p.wrox.com Forums.

You are currently viewing the Excel VBA section of the Wrox Programmer to Programmer discussions. This is a community of tens of thousands of software programmers and website developers including Wrox book authors and readers. As a guest, you can read any forum posting. By joining today you can post your own programming questions, respond to other developers’ questions, and eliminate the ads that are displayed to guests. Registration is fast, simple and absolutely free .
DRM-free e-books 300x50
Reply
 
Thread Tools Search this Thread Display Modes
  #1 (permalink)  
Old December 2nd, 2005, 12:29 PM
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:



VBA:

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
        Next
        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"
            cel.Copy
            celTemp.PasteSpecial xlPasteValues
            celTemp.PasteSpecial xlPasteFormats
            .MergeCells = True

            celTemp.EntireRow.AutoFit

             'For some reason, celTemp.EntireRow.Height changes when .MergeCells=True
            If celTemp.EntireRow.Height > ReqdHeight Then ReqdHeight = celTemp.EntireRow.Height
        End With
    Next
    colCopy.ClearContents
    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:



VBA:

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)
    Else
        Set rg = Union(rg, Range(X))
    End If
Next

Set targ = Intersect(rg, Target)
rg.Select
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
Else
    targ.Activate
End If

Then, in a module I had to put this:



VBA:

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
  #2 (permalink)  
Old March 1st, 2006, 07:11 PM
Registered User
 
Join Date: Mar 2006
Location: , , .
Posts: 1
Thanks: 0
Thanked 0 Times in 0 Posts
Default

If you didn't find the solution yet, try this code for autofit merged cells.
I started with the same code as you found on the web and ended with complete redo.
 It is much easier on the worksheet
 it doesn;t incert or delet anything and leaves no trace/garbage anywhere.


'-------------------------
Private Sub autoFit_Row_w_Merged_Cells(Target As Range, Optional addHeight As Double = 1)
    ' Autofits merged cells in the row.
    ' Fixes Excel bug in fitting
    ' Does this FAST
    ' created by Shura Krechetov, 2006,
    If ActiveSheet.ProtectContents Then
        MsgBox ("worksheet is protected. Can not do anything")
        Exit Sub
    End If
    'go over all all the merged ranges
    Dim r As Range, c As Range
    Dim ReqdHeight As Double
    ReqdHeight = 0
    Set r = Target.Cells(1, 1).EntireRow
    Dim col As Integer, colMax As Integer
    col = Target.Cells(1, 1).Column
    colMax = col + Target.Columns.Count - 1
    Do While col < colMax
        With r.Cells(1, col)
            If .MergeCells And .WrapText Then
                ' autofit row here
                '==========================

                ' calculate width of current merged area
                Dim mergedWidth As Double, mergedRange As Range
                Set mergedRange = .MergeArea
                mergedWidth = mergedRange.Width ' in points

                'unmerge cells
                .MergeCells = False
                'save the column width for the future recovery
                Dim tempColWidth As Double
                tempColWidth = .ColumnWidth

                ' make current column as wide as merged area
                ' one would ask why I convert from points (width)
                ' to characters (columnwidth) and back
                ' Apparently measurement in Columnwidth is much less accurate and
                ' I had a lot of problem matchin widthes with columnwidth
                ' Also Width property is applicable to therange and there is no
                ' need to cycle over all cells
                .ColumnWidth = points2char = 0.1905 * p - 0.7139 'Convert from points to "characters"
                ' fit it
                .EntireRow.AutoFit

                'save height for the moment look for maximum over the row
                If .RowHeight > ReqdHeight Then ReqdHeight = .RowHeight

                'recover current column width
                .ColumnWidth = tempColWidth

                mergedRange.MergeCells = True
                .EntireRow.RowHeight = Application.Max(ReqdHeight / mergedRange.Rows.Count + 0.5, 12.75) + addHeight
                'go to the next cell after merged area
                col = col + mergedRange.Columns.Count
            Else
                col = col + 1
            End If
        End With
    Loop
End Sub

Reply With Quote
Reply


Thread Tools Search this Thread
Search this Thread:

Advanced Search
Display Modes

Posting Rules
You may not post new threads
You may not post replies
You may not post attachments
You may not edit your posts

BB code is On
Smilies are On
[IMG] code is Off
HTML code is Off
Trackbacks are Off
Pingbacks are On
Refbacks are Off


Similar Threads
Thread Thread Starter Forum Replies Last Post
How to disable a tab on a tab control. dbradley VB.NET 6 April 14th, 2011 10:04 AM
how to many textbox jump by tab in order? richie86 ASP.NET 1.0 and 1.1 Basics 3 December 11th, 2005 04:29 PM
Best tab order implementation policy? nerssi Javascript 1 June 26th, 2005 05:05 AM
Using the TAB ORDER with ENTER KEY ? thomaz C# 0 September 10th, 2003 08:10 AM
document node order vs sort node order. ladyslipper98201 XSLT 2 June 5th, 2003 11:06 AM



All times are GMT -4. The time now is 10:22 AM.


Powered by vBulletin®
Copyright ©2000 - 2020, Jelsoft Enterprises Ltd.
© 2013 John Wiley & Sons, Inc.