Zeilenhöhe verbundene Zellen vor Drucken ausführen
02.01.2017 16:44:32
Jana
Ich habe mir hier vor einiger Zeit ein Makro zusammengesucht mit dem sich die Höhe der verbundenen Zellen prima anpassen lässt. (Vorweg: Ja, die verbundenen Zellen müssen leider sein, das Dokument hat ne Historie und wird nicht nur von mir und auch als Vorlage für weitere Vorgänge genutzt.)
ABER: Das was ich habe, funktioniert ja auch. Es ist unter Module, Modul 1 abgelegt. Ich kann es im Dokument starten und es läuft für die jeweils markierten Zellen problemlos durch.
Jetzt hätte ich es aber zwecks einfacherem Handling gerne so, dass es automatisch VOR dem Drucken des Dokuments abläuft. Dazu muss ich sagen, dass sich die Länge des Dokuments immer wieder ändert, also die beschriebenen Zeilen. Aber wie geht das? Ich habe versucht es so wie es ist in "Diese Arbeitsmapp" mit "Workbook" und dann "BeforePrint" einzufügen, aber das geht nicht.
Leider habe ich wenig bis keine Ahnung von VBA, interessiere mich aber sehr fürs programmieren und würde es jetzt gerne so hinkniffeln, das es geht. Mag jemand helfen?
Sub tr_Start()
Dim rngZelle As Range
For Each rngZelle In Selection
ZeilenhoeheVerbundeneZellen rngZelle
Next rngZelle
End Sub
Sub ZeilenhoeheVerbundeneZellen(rngZelle As Range)
'passt die Zeilenhöhe bei verbundenen Zellen automatisch an
'von Hans Herber / angepasst von Thomas Ramel (t.ramel@mvps.org)
'Aufrufen per Übergabeparameter mit der folgenden Zeile:
'Sub test()
'ZeilenhoeheVerbundeneZellen (ActiveSheet.Range("A1"))
'End Sub
Dim CurrentRowHeight As Single, MergedCellRgWidth As Single
Dim CurrCell As Range
Dim CellWidth As Single, PossNewRowHeight As Single
Dim iX As Integer
If IsEmpty(rngZelle) Then
Set rngZelle = ActiveCell
End If
If rngZelle.MergeCells Then
With rngZelle.MergeArea
If .Rows.Count = 1 And .WrapText = True Then
Application.ScreenUpdating = False
CurrentRowHeight = .RowHeight
CellWidth = rngZelle.ColumnWidth
For Each CurrCell In rngZelle.MergeArea
MergedCellRgWidth = CurrCell.ColumnWidth + _
MergedCellRgWidth
iX = iX + 1
Next
MergedCellRgWidth = MergedCellRgWidth + (iX - 1) * 0.9
.MergeCells = False
.Cells(1).ColumnWidth = MergedCellRgWidth
.EntireRow.AutoFit
PossNewRowHeight = .RowHeight
.Cells(1).ColumnWidth = CellWidth
.MergeCells = True
.RowHeight = PossNewRowHeight
End If
End With
End If
End Sub
Anzeige