Live-Forum - Die aktuellen Beiträge
Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Merged Cell Row Height ohne select?

Forumthread: Merged Cell Row Height ohne select?

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.
Anzeige

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

Betreff
Datum
Anwender
Anzeige
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
Anzeige
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
Anzeige
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
Anzeige
;

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Entdecke mehr
Finde genau, was du suchst

Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden

Suche nach den besten Antworten
Unsere beliebtesten Threads

Entdecke unsere meistgeklickten Beiträge in der Google Suche

Top 100 Threads jetzt ansehen
Anzeige