VBATools

Auto dopasowanie wysokości do tekstu komórek scalonych

by on May.20, 2011, under Excel, Porady

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 arkusza np: Arkusz1 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.

:, , , ,

7 Comments for this entry

  • Łukasz Kowal

    Bardzo fajna procedura!

    Zmieniłbym tylko warunek

    If NewRwHt > wysokosc Then
    ma.RowHeight = NewRwHt
    Else
    ma.RowHeight = wysokosc
    End If

    na

    If NewRwHt wysokosc Then
    ma.RowHeight = NewRwHt
    Else
    ma.RowHeight = wysokosc
    End If

    wtedy korekta wysokości wiersza działac będzie w obie strony.

  • Marcin

    Witam,
    nie jestem pewny czy robię wszystko dobrze. Nie znam się na tym. Pierwszy raz próbuję zastosować makro.

    wywołuję VBA przez ALT+ F11 klikam na ThisWorkbook przeklejam kod który podaliście powyżej. Zapisuję jako .xlsm. Nic się nie zmienia.

    Chciałbym żeby wysokość wiersza scalonych komórek dostosowywała się automatycznie do zawartości tekstu.

    czy coś pominąłem, albo powinienem zrobić inaczej ?

    • vbatools

      Procedura działa w zakresie wykonywania czynności. Czyli dopasowuje na bieżąco, a nie szuka gdzie dopasować w obszarze arkusza gdzie nie realizujemy żadnych zmian.

  • Koleś

    Cześć, bardzo podoba mi się idea takiego makra. Pytanie: jak można wykorzystać je do ogólnego użytku? Czy można je wkleić do pliku PERSONAL?

  • Piotr

    Dzięki za rozwiązanie. Po raz drugi odwołałem się do niego. Pozdrawiam.

Leave a Reply

Recently Active Members

Profile picture of vbatools
Profile picture of Karol Stilger
Profile picture of Joanna Subik
Profile picture of Anorak
Profile picture of marcinmachalowski
Profile picture of programistaaccess
Profile picture of piotrpawlik
Profile picture of Emil Wasilewski
Profile picture of kicekpicek
Profile picture of coldfusion
Profile picture of Gosia Borzęcka
Profile picture of lukaszch
Profile picture of itadministracja
Profile picture of farbenia
Profile picture of Łukasz Kałużny
Profile picture of kabzinski
Profile picture of rtynski
Profile picture of leszekbetlinski
Profile picture of Iv
Profile picture of Justyna Spychała