VBA宏的行为取决于所选单元格

Question

I have an AutoFitMergedCellRowHeight subroutine that takes a merged cell as an argument and then fixes its height so that all the text will be visible. The FixAll sub is activated when a button is pressed.

The problem is it's behavior is unstable. When a cell is selected that is in the same column as the merged cell (column 4) the height is one size (smaller, but the text is 100% visible); when a cell is selected outside that column but inside a table nothing happens; when a cell is selected outside the table the height is fixed but get too big.

Why is this happening? I can't see anything related to a selected cell in the sub.

Sub FitAll()
   AutoFitMergedCellRowHeight (Cells(3, 4))
End Sub

Sub AutoFitMergedCellRowHeight(cell As Range)
    Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
    Dim CurrCell As Range
    Dim ActiveCellWidth As Single, PossNewRowHeight As Single
    If cell.MergeCells Then
        With cell.MergeArea
            .WrapText = True
            If .Rows.Count = 1 Then
                cell = cell.MergeArea.Cells(1, 1)
                MsgBox (cell.Row & "and" & cell.Column)

                Application.ScreenUpdating = False
                CurrentRowHeight = .RowHeight
                ActiveCellWidth = cell.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

EDIT: I compare my results also to the same sub that doesn't use an argument but rather a selected cell. The results differ thought even after applying the changes CLR suggested..

Sub AutoFitMergedActiveCellRowHeight()
    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
            .WrapText = True
            If .Rows.Count = 1 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
    'MsgBox ("DONE")
    MsgBox (ActiveCell.Row & "and" & ActiveCell.Column)
End Sub

Answer 1

For Each CurrCell In Selection is looking at selected cell, not cell passed in parameter.

I think you want to replace:

For Each CurrCell In Selection
    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next

with something like:

For Each CurrCell In cell.MergeArea
    MergedCellRgWidth = CurrCell.ColumnWidth + MergedCellRgWidth
Next