Autofit in Merge Cells

  • Thread starter Thread starter Guest
  • Start date Start date
G

Guest

I am writing a program in VB.NET that populates an Excel spreadsheet.

I know that it is not possible to have autoheight or autofit on merged
cells. I need the height of the row to expand to fit an undetermined amount
of text. I wonder if anyone has code to get around this problem. I need to
find a way to get around this problem and fast. Anyone found a way around it?

Thanks in Advance,
Elena
 
Hi Elena,

Try the following code from Jim Rech:

'=============>>
Public Sub AutoFitMergedCellRowHeight()
'----------------------------------------------
'\\ Jim RECH http://tinyurl.com/esbrx
'\\ This macro does an autofit of row heights on merged cells:

'\\ Simulates row height autofit for a merged cell if the active cell..
'\\ - is merged.
'\\ - has Wrap Text set.
'\\ - includes only 1 row.
'\\ Unlike real autosizing the macro only increases row height
'\\ (if needed). It does not reduce row height because another
'\\ merged cell on the same row may needed a greater height
'\\ than the active cell.
'----------------------------------------------

Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If ActiveCell.MergeCells Then
With ActiveCell.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = ActiveCell.ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight > PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If
End Sub
'<<=============
 
I changed the code, but VB.NET gives two errors:
Dim CurrCell As Range -> 'System.Data.Range' is not accessible in this
context beacuse it is 'Private'
For Each CurrCell In Selection - > error states "Selection is not Declared"


Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If CoverWs.Range(strA1).MergeCells Then
With CoverWs.Range(strA1).MergeArea
If .Rows.Count = 1 And .WrapText = True Then
ThisApplication.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = CoverWs.Range(strA1).ColumnWidth
For Each CurrCell In Selection
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit()
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight >
PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If


If I declare the Selection, how do I then define it?
I'm not sure about the other error either.

Thanks so much,
Elena
 
try changing

For Each CurrCell In Selection

to

For Each CurrCell In CoverWs.Range(strA1).MergeArea

Maybe it will clear up both errors.
 
I changed the code and now get an error on this line of code (full code
below): For Each CurrCell In CoverWs.Range(strA1).MergeArea

Error:
An unhandled exception of type 'System.Runtime.InteropServices.COMException'
occurred in mscorlib.dll

Additional information: Member not found.


Current Code:
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Excel.Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single

If CoverWs.Range(strA1).MergeCells Then
With CoverWs.Range(strA1).MergeArea
If .Rows.Count = 1 And .WrapText = True Then
ThisApplication.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = CoverWs.Range(strA1).ColumnWidth
For Each CurrCell In
CoverWs.Range(strA1).MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
Next
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit()
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = ActiveCellWidth
.MergeCells = True
.RowHeight = IIf(CurrentRowHeight >
PossNewRowHeight, _
CurrentRowHeight, PossNewRowHeight)
End If
End With
End If



Thanks again,
Elena
 
Back
Top