VBA Tools

Excel posiada możliwość scalenia komórek, jednakże nie radzi sobie z ich zarządzaniem. W przypadku jednej komórki jest to prosta sprawa. Funkcja auto dopasowania wysokości, szerokości, zawijania tekstu jest elementarna ale dla kilka cell zagregowanych razem jest już problem.

Poniższa procedura umieszczona w module ThisWorkbook pozwoli na automatyczne dobranie wysokości komórek do tekstu. Oczywiście ważną rolę odbiera tutaj rodzaj czcionki. Przydatne jest to głównie w przypadku tekstu, opisującego pola arkusza dla różnego rodzaju formularzy Excelowych.

Private Sub Worksheet_Change(ByVal Target As Range)
'Mod by MVP OShon from VBATools.pl
Dim NewRwHt As Single
Dim cWdth As Single, MrgeWdth As Single
Dim c As Range, cc As Range
Dim ma As Range, wysokosc As Currency

With Target
 wysokosc = .RowHeight
 If .MergeCells And .WrapText Then
 Set c = Target.Cells(1, 1)
 cWdth = c.ColumnWidth
 Set ma = c.MergeArea
 For Each cc In ma.Cells
  MrgeWdth = MrgeWdth + cc.ColumnWidth
 Next
 If wysokosc > c.RowHeight Then Exit Sub
   Application.ScreenUpdating = False
   ma.MergeCells = False
   c.ColumnWidth = MrgeWdth
   c.EntireRow.AutoFit
   NewRwHt = c.RowHeight
   c.ColumnWidth = cWdth
   ma.MergeCells = True
   If NewRwHt > wysokosc Then
     ma.RowHeight = NewRwHt
   Else
     ma.RowHeight = wysokosc
   End If
  cWdth = 0: MrgeWdth = 0
  Application.ScreenUpdating = True
 End If
End With
End Sub

(c) Shon Oskar – www.VBATools.pl

Wszelkie prawa zastrzeżone. Żadna część ani całość tego artykułu nie może być powielana ani publikowana bez zgody autora.