Καλημέρα σε όλους.
Φίλε Νίκο, δε γνωρίζω κάποια μέθοδο που να τροποποιεί αυτόματα το ύψος της γραμμής σε περιοχή συγχωνευμένων κελιών.
Ωστόσο αν δεν μπορούμε να αποφύγουμε τα συγχωνευμένα κελιά, μπορούμε να κάνουμε τα εξής:
Δημιουργούμε ένα φύλλο εργασίας, με όνομα κλάσης "ShData" και δίνουμε στο πρώτο κελί του (Α1) το όνομα "HelpCell".
Μπορούμε να κρύψουμε το φύλλο αυτό αφού προηγουμένως φροντίσουμε η μορφοποίηση του κελιού "HelpCell" να είναι η ίδια με αυτή των περιοχών με τα συγχωνευμένα κελιά.
Κατόπιν σε μια νέα λειτουργική μονάδα (Module) αντιγράφουμε τον παρακάτω κώδικα:
Κώδικας:
Option Explicit
Sub SetRowHeight()
Dim colWidth As Integer
Dim oRange As Range
Dim oCell As Range
Dim MergedCell As Range
Dim HelpCell As Range
Set HelpCell = Range("HelpCell")
Set oRange = ShData.Range("b2", ShData.Range("b" & Rows.Count).End(xlUp))
Application.ScreenUpdating = False
For Each oCell In oRange
If oCell.MergeCells Then
If colWidth = 0 Then
For Each MergedCell In oCell.MergeArea
colWidth = colWidth + MergedCell.ColumnWidth
Next
End If
If HelpCell.ColumnWidth <> colWidth Then
HelpCell.ColumnWidth = colWidth
End If
HelpCell.Value = oCell.Value
HelpCell.EntireRow.AutoFit
oCell.RowHeight = HelpCell.RowHeight
End If
Next
End Sub
Αντιστοιχούμε τον κώδικα σε ένα κουμπί και εκτελούμε όποτε χρειαστεί για να οριστεί το ύψος των συγχωνευμένων κελιών στη στήλη Β:Β.
Τι κάνεις ο κώδικας;
Δίνει στο πλάτος του κελιού
HelpCell την τιμή του συνολικού πλάτους των συγχωνευμένων κελιών.
Σε κάθε μια από τις συγχωνευμένες περιοχές στη στήλη Β:Β:
- Αντιγράφει τα περιεχόμενα του πρώτου κελιού της συγχωνευμένης περιοχής (στην περίπτωση μας στη στήλη Β:Β) στο κελί HelpCell
- Εκτελεί την εντολή: HelpCell.EntireRow.AutoFit. για να ρυθμιστεί εκ νέου το ύψος του κελιού HelpCell .
- Ρυθμίζει το ύψος της γραμμής των συγχωνευμένων κελιών σύμφωνα με το ύψος τοτ βοηθητικού κελιού HelpCell
Δες ένα παράδειγμα στο συνημμένο.
Καλή συνέχεια.
Με εκτίμηση
Τάσος