Kuz9
Newbie | Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Такая бЯда. Делал отчет, в котором есть объединенные ячейки, в которые выводится строчный текст. Как известно в экселе баг с авторасширение объединенных ячеек, я нашел макрос, которые считает высоту, подредактировал его, но пока. Остался один штрих, нужно в цикле нужно задать условие, которое будет проверять объединены ли мои ячейки, если да то выставлять автовысоту, если нет то след ячейка. Те ячейка "F15:I15", "F16:I16" могут быть объединены, а след ячейки "F17:I17" не объединены, 18 объединена.
Sub RowHeightFiting3()
' ???????????? ?????? ?????? ???? ????????!!!
' ???? ????????? ????????? ?????? ??? ?????????? ??????, ?? ????? ?????????? MyRanAdr ????????? ?????? ????? ??????? ???????????? ?????? '(????, MyRanAdr = "D4:G7" ?????? ?????? MyRanAdr = ActiveCell.MergeArea.Address)
Application.ScreenUpdating = False
Dim MyNormalMiddleWidth, MyNormalEdgeWidth
Dim c1, c2, w1, w2 '????????? ?????????? ????? ???????? ? ???? ? ??
Dim MyTempCell As Range
Dim OldColWidth
Set MyTempCell = Cells(65536, 256)
OldColWidth = MyTempCell.ColumnWidth
c1 = 10 ' ?????? ? ???? ????? ?????????? ?????, ?? ????? ?? ????? 1 (??? ?????? ??????? ?????????? ?????? ??? ??????),
c2 = 15 ' ? ????? ????? 3 ? ????????????? (??? ?????????? ??????? ?????? ??????????..... ???????, ? ???? ??? ????????? ?????? ???????????)
MyTempCell.ColumnWidth = c1
c1 = MyTempCell.ColumnWidth
w1 = MyTempCell.Width
MyTempCell.ColumnWidth = c2
c2 = MyTempCell.ColumnWidth
w2 = MyTempCell.Width
MyNormalMiddleWidth = Format((w2 - w1) / (c2 - c1), "#0.00")
MyNormalEdgeWidth = Format((c2 * w1 - c1 * w2) / (c2 - c1), "#0.00")
MyTempCell.ColumnWidth = OldColWidth
Dim MyRanAdr(50) As String
MyRanAdr(0) = "F15:I15"
MyRanAdr(1) = "F16:I16"
MyRanAdr(2) = "F17:I17"
MyRanAdr(3) = "F18:I18"
MyRanAdr(4) = "F19:I19"
MyRanAdr(5) = "F20:I20"
MyRanAdr(6) = "F21:I21"
MyRanAdr(7) = "F22:I22"
MyRanAdr(8) = "F23:I23"
MyRanAdr(9) = "F24:I24"
MyRanAdr(10) = "F25:I25"
MyRanAdr(11) = "F26:I26"
MyRanAdr(12) = "F27:I27"
For b = 0 To 12
'здесь шлепнуть наш If проверяющий объединенная ли ячейка или нет
Dim MergeAreaTotalHeight(50), NewRH(50) As Long
Dim MergeAreaFirstCellColWidth(50), MergeAreaFirstCellColHeight(50) As Long
MergeAreaTotalHeight(b) = Range(MyRanAdr(b)).Height ' ?????? ???? ???????????? ?????? ? ??. ??
MergeAreaFirstCellColWidth(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireColumn.ColumnWidth ' ?????? ??????? ??????? ? ???????????? ??????
MergeAreaFirstCellColHeight(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight ' ?????? ?????? ?????? ? ???????????? ??????
Range(MyRanAdr(b)).Cells(1, 1).ColumnWidth = (Range(MyRanAdr(b)).Width - MyNormalEdgeWidth) / MyNormalMiddleWidth '????????? ?????? ??????? ??????? ?????. ?????? ?????? ????? ?????? ?????. ?????? '''??? ????????!!!
Range(MyRanAdr(b)).WrapText = True
Range(MyRanAdr(b)).MergeCells = False
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.AutoFit
NewRH(b) = Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight
Range(MyRanAdr(b)).MergeCells = True
Range(MyRanAdr(b)).Cells(1, 1).EntireColumn.ColumnWidth = MergeAreaFirstCellColWidth(b)
If NewRH(b) < MergeAreaTotalHeight(b) Then '???? ????? ?????? ?????? ???????????, ?? ????????? ??????????? ??????!
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight = MergeAreaFirstCellColHeight(b)
Else
Range(MyRanAdr(b)).Cells(1, 1).EntireRow.RowHeight = NewRH(b) - (MergeAreaTotalHeight(b) - MergeAreaFirstCellColHeight(b)) ' ??? 1st ?????? ? ?????.??????
End If
'Range(MyRanAdr).EntireRow.RowHeight = NewRH / Range(MyRanAdr).Rows.Count '??? ?????? ?????? ???? ????? ? ?????.?????? (?????? ??????????? ????? If)
Application.ScreenUpdating = True
Next b
End Sub |
