Merged Cell Row Height ohne select?
06.12.2021 15:49:41
Klaus
ich habe eine Vorlage, in der ich mit horizontal verbundenen Zellen arbeiten muss. Dadurch funktioniert
Rows("21:21").AutoFit
nicht mehr, wie ich lernen musste. Das Problem gegoogelt hat mir von hier:http://www.office-loesung.de/ftopic137262_0_0_asc.php
eine Lösung gebracht die funktioniert, und zwar diese:
Sub Makro2()
Call AutoFitMergedCellRowHeight(Tabelle2.Range("B21:D21"))
Call AutoFitMergedCellRowHeight(Tabelle2.Range("B23:D23"))
Call AutoFitMergedCellRowHeight(Tabelle2.Range("B25:D25"))
Call AutoFitMergedCellRowHeight(Tabelle2.Range("B27:D27"))
Call AutoFitMergedCellRowHeight(Tabelle2.Range("B29:D29"))
End Sub
Sub AutoFitMergedCellRowHeight(myRange As Range)
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim ActiveCellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
Dim i As Integer
myRange.Select
If Selection.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
iX = iX + 1
Next
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.71
.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
Nun meine Frage: Bekomme ich da irgendwie das Select weg, oder ist das der eine von tausend Fällen wo es ohne Select nicht geht? Ich möchte das Blatt eigentlich nicht aktivieren während das Makro läuft.Ideen?
LG,
Klaus M.
Anzeige