Как определить, подходит ли текст в ячейке?

Question

Я хотел бы написать некоторый код vba, который контролирует событие OnChange для листа и выполняет некоторую настройку, если текст не соответствует ячейке. I.e. сделать текст меньше или завернуть и т.д ..

Я знаю, что может иметь Excel автоматически сжать текст, и я знаю, как включить обертку в VBA, но ...

как я могу проверить в УВЕ ли текст вписывается в ячейку для начала?

Answer 1

Быстрый и грязный способ, который не требует проверки каждой ячейки.

Этот метод обычно используется для отображения всех данных.

Sub Sample() 
    With Thisworbook.Sheets("Sheet1").Cells 
     .ColumnWidth = 254.86 '<~~ Max Width 
     .RowHeight = 409.5 '<~~ Max Height 
     .EntireRow.AutoFit 
     .EntireColumn.AutoFit 
    End With 
End Sub 

Я использую этот метод, если я хочу, чтобы обернуть текст (если применимо) и сохранить строку постоянной ширины

Sub Sample() 
    With Thisworbook.Sheets("Sheet1").Cells 
     .ColumnWidth = 41.71 '<~~ Keep the column width constant 
     .RowHeight = 409.5 
     .EntireRow.AutoFit 
    End With 
End Sub 

Примечание: Это не применимо для объединенных ячеек. Для этого существует отдельный метод.

Answer 2

Я использую «грязный» метод - это только один, который я знаю: сила AutoFit и проверка новой ширины/высоты.

Однако мы не можем предоставить грант, который был выбран ячейкой, которая вынудила новую посадку. Поэтому я выбираю, копируя содержимое ячейки на пустой рабочий лист.

Это, конечно, вызывает много других проблем и более обходных решений.

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Fits(Target) Then 
     'Notice that Target may have multiple cells!!! 
    End If 
End Sub 

Function Fits(ByVal Range As Range) As Boolean 
    Dim cell As Range, tmp_cell As Range, da As Boolean, su As Boolean 
    'Stores current state and disables ScreenUpdating and DisplayAlerts 
    su = Application.ScreenUpdating: Application.ScreenUpdating = False 
    da = Application.DisplayAlerts: Application.DisplayAlerts = False 
    'Creates a new worksheet and uses first cell as temporary cell 
    Set tmp_cell = Range.Worksheet.Parent.Worksheets.Add.Cells(1, 1) 
    'Assume fits by default 
    Fits = True 
    'Enumerate all cells in Range 
    For Each cell In Range.Cells 
     'Copy cell to temporary cell 
     cell.Copy tmp_cell 
     'Copy cell value to temporary cell, if formula was used 
     If cell.HasFormula Then tmp_cell.Value = cell.Value 
     'Checking depends on WrapText 
     If cell.WrapText Then 
      'Ensure temporary cell column is equal to original 
      tmp_cell.ColumnWidth = cell.ColumnWidth 
      tmp_cell.EntireRow.AutoFit 'Force fitting 
      If tmp_cell.RowHeight > cell.RowHeight Then 'Cell doesn't fit! 
       Fits = False 
       Exit For 'Exit For loop (at least one cell doesn't fit) 
      End If 
     Else 
      tmp_cell.EntireColumn.AutoFit 'Force fitting 
      If tmp_cell.ColumnWidth > cell.ColumnWidth Then 'Cell doesn't fit! 
       Fits = False 
       Exit For 'Exit For loop (at least one cell doesn't fit) 
      End If 
     End If 
    Next 
    tmp_cell.Worksheet.Delete 'Delete temporary Worksheet 
    'Restore ScreenUpdating and DisplayAlerts state 
    Application.DisplayAlerts = da 
    Application.ScreenUpdating = su 
End Function 

Решение получило слишком много сложностей, могут возникнуть проблемы, которые я не просматривал.

Это не будет работать в книгах только для чтения, однако ячейки в книгах только для чтения также не меняются!