Показать сообщение отдельно
Старый 15.06.2012, 17:19   #3  
Gustav is offline
Gustav
Moderator
Аватар для Gustav
SAP
Лучший по профессии 2009
 
1,858 / 1152 (42) ++++++++
Регистрация: 24.01.2006
Адрес: Санкт-Петербург
Записей в блоге: 19
Цитата:
Сообщение от lev Посмотреть сообщение
можно попробовать выполнить AutoFit по строке (выделенным строкам)
К сожалению, не прокатит. Нужно примерно так:

How to use Row.AutoFit for merged Excel cells


Я уже как-то использовал в ABAPе, у меня есть отлаженный фрагмент на VBScript для использования с MS Script Control:
Код:
  `Option Explicit                                                                                                     `

  `Public Function MergeAndFit(r, xlApp)                                                                               `

  `   'http://www.source-code.biz/snippets/vbasic/11.htm                                                               `
  `   ' Merges a cell range, wraps text and auto-fits the row height.                                                  `
  `   ' Because the Row.AutoFit method ignores merged cells, we temporarily expand the first column of                 `
  `   ' the cell range to the width of the whole cell range and call AutoFit with the un-merged cell.                  `

  `   Dim Row                                                                                                          `
  `   Dim Column1                                                                                                      `
  `   Dim RangeWidth                                                                                                   `
  `   Dim OldColumn1Width                                                                                              `
  `   Dim OldRowHeight                                                                                                 `
  `   Dim FitRowHeight                                                                                                 `
  `   Dim i 'As Integer                                                                                                `

  `   Set r = r.MergeArea 'чтобы можно было передавать одну (первую) ячейку                                            `
  `   Set Row = r.Rows(1)                                                                                              `
  `   Set Column1 = r.Columns(1)                                                                                       `
  `   RangeWidth = r.Width                                                                                             `
  `   OldColumn1Width = Column1.ColumnWidth                                                                            `
  `   For i = 1 To 3                     ' approximation of Column1.ColumnWidth in 3 steps                             `
  `      Column1.ColumnWidth = RangeWidth / Column1.Width * Column1.ColumnWidth                                        `
  `   Next                                                                                                             `
  `   r.WrapText = True                                                                                                `
  `   r.MergeCells = False                                                                                             `
  `   OldRowHeight = Row.rowHeight                                                                                     `
  `   Row.AutoFit                                                                                                      `
  `   FitRowHeight = Row.rowHeight                                                                                     `
  `   r.MergeCells = True                                                                                              `
  `   Column1.ColumnWidth = OldColumn1Width                                                                            `

  `   'VBScript doesn't support the IIf() function                                                                     `
  `   'Row.rowHeight = IIf(FitRowHeight > OldRowHeight, FitRowHeight, OldRowHeight)                                    `
  `   Row.rowHeight = xlApp.WorksheetFunction.Max(FitRowHeight, OldRowHeight)                                          `

  `   MergeAndFit = Row.rowHeight                                                                                      `

  `End Function                                                                                                        `