Merged Cell Row Height ohne select?

Forumthread: Merged Cell Row Height ohne select?

06.12.2021 15:49:41

Klaus

Hallo,
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.

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

AW: Merged Cell Row Height ohne select?

06.12.2021 16:12:37

volti

Hallo Klaus,
keriere doch eine MergedArea-Varibale und arbeite mit der. Sollte ohne Select und von anderem Blatt aus funktionieren.
Habe Deine Code aber nicht getestet und vollständig durchleuchtet.
Hier ein Beispielausschnitt:

Sub Beispiel()
  Dim MA As Range, MyRange As Range
 

  If MyRange.MergeCells Then
     Set MA = MyRange.MergeArea
     Debug.Print MA.RowHeight
     MA.RowHeight = 20
  End If
End Sub

Gruß
Karl-Heinz

AW: Merged Cell Row Height ohne select?

06.12.2021 16:50:56

UweD

so?


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
If myRange.MergeCells Then
With myRange
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
ActiveCellWidth = .ColumnWidth
For Each CurrCell In myRange
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

LG UweD

AW: Merged Cell Row Height ohne select?

06.12.2021 16:56:52

Klaus

Ja Uwe, das funktioniert. Danke!
Jetzt wo ich drauf schaue - das hätte ich auch selber hinbekommen. Aber lieber zweimal nachgefragt als einmal nachgedacht :-)
Dir auch danke, Karl-Heinz - wollte deine Idee gerade analysieren, da ist Uwe dir mit der Komplettlösung vorweg gekommen.

Prima. Danke für die Rückmeldung. owT

06.12.2021 16:58:49

UweD

AW: Merged Cell Row Height ohne select?

06.12.2021 18:02:52

volti

Bedanke mich auch herzlich für die Rückmeldung, Klaus.
Ist einigen anderen Fragestellern ja nicht möglich, schon gar nicht, wenn die Lösung nicht genommen wurde.
Gruß
Karl-Heinz

Beliebteste Forumthreads (12 Monate)

Merged Cell Row Height ohne select?

Forumthread: Merged Cell Row Height ohne select?

5 Beiträge zum Forumthread Beiträge zu diesem Forumthread

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

5
Beiträge zum Forumthread

Beiträge zu diesem Forumthread