Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Макрос для автоматического изменения высоты объединенных строк
 
Нужен макрос который для объединенных ячеек будет выполнять следующие условия:
если отсутствует текст то высота равна 0 (объединенные ячейки скрыты);
Размер увеличивается по ходу наполнения текстом объединенных ячеек и собственно уменьшается по уходу их удаления в плоть до скрытия.
 
Добрый день, подумал, именно изменение размера высоты ячейки под текст,не совсем тривиальная задача, а вот просто скрытие объединенных ячеек в случае отсутствия в них какого рода информации и отображение в случае появления набросал вот
Код
Sub test()
On Error Resume Next
Dim coll As New Collection
Dim iRange As Range
Dim iCell As Range
   Set iRange = ActiveSheet.UsedRange
      For Each iCell In iRange
         If iCell.MergeCells Then
            coll.Add iCell.MergeArea.Address, iCell.MergeArea.Address
               If Err.Number = 0 Then
                  If iCell.Value = "" Then iCell.MergeArea.RowHeight = 0 Else iCell.MergeArea.EntireRow.AutoFit
               Else
                  Err.Clear
               End If
         End If
      Next
End Sub
А вот и попробовал что то придумать (Файл приложил):
Код
Sub test()
On Error Resume Next
Application.ScreenUpdating = False
Dim coll As New Collection
Dim iRange As Range
Dim iCell As Range
Set iRange = ActiveSheet.UsedRange
For Each iCell In iRange
If iCell.MergeCells Then
coll.Add iCell.MergeArea.Address, iCell.MergeArea.Address
If Err.Number = 0 Then
If iCell.Value = "" Then
iCell.MergeArea.RowHeight = 0
Else
y = iCell.MergeArea.ColumnWidth
Set sh = Sheets.Add
With sh.Cells(1, 1)
  .HorizontalAlignment = iCell.MergeArea.HorizontalAlignment
  .VerticalAlignment = iCell.MergeArea.VerticalAlignment
  .WrapText = True
  .ColumnWidth = y * iCell.MergeArea.Columns.Count
  .Value = iCell.Value
  .EntireRow.AutoFit
  x1 = .RowHeight
End With
Application.DisplayAlerts = False
sh.Delete
Application.DisplayAlerts = True
iCell.MergeArea.RowHeight = x1 / iCell.MergeArea.Rows.Count
End If
Else
Err.Clear
End If
End If
Next
Application.ScreenUpdating = True
End Sub
Изменено: lexey_fan - 12 Июл 2016 22:43:54 (Добавлен код и файл)
Если очень захотеть - можно в космос полететь ;)
 
Цитата
WaleraPP написал:
если отсутствует текст то высота равна 0 (объединенные ячейки скрыты);
Размер увеличивается по ходу наполнения текстом
А как Вы будете вводить текст в скрытую строку?
 
А может быть разработка nerv'a подойдёт: http://www.excelworld.ru/forum/3-23520-1?
 
lexey_fan Спасибо, то что нужно . Только вот хотел еще узнать. Подскажите, а как сделать так, что бы макрос на всей книге работал  И еще что бы макрос не на все объединенные ячейки работал, а только на те которые я выберу ?
Изменено: WaleraPP - 14 Июл 2016 13:37:12
 
Юрий М,Это шаблон для программы, которая сама подставляет в ячейке нужные данные. В ручную делать нечего не нужно  
 
Вот здесь я приводил функцию подбора высоты и ширины объединенных ячеек: http://www.planetaexcel.ru/forum/index.php?PAGE_NAME=read&FID=1&TID=63026
Попробуйте, может удобнее будет прикрутить только к нужным.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
The_Prist,Спасибо. Я попробую обязательно. Просто я VBA вообще не знаю. Предыдущий код коек как прикрутил к шаблону, весь день убил. Замучался =) . А так поэксперементировать интересно.
 
А там по сути надо лишь функцию разместить и вызывать для нужных ячеек потом. В теме написано как вызывать. Правда, вызывать надо по отдельности для каждой ячейки. Но есть и плюс - функция сама отсекает ячейки, которые не объединены и никак их не изменяет. Поэтому можно для цикла взять ячейки с запасом.
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
Страницы: 1
Читают тему (гостей: 1)
Наверх