В ячейку C8 вписан текст - высотой шрифта 10. Рядом находится фигура "Прямоугольник 2". Известно что после вставки текста в фигуру - ее размеры приходится подгонять, чтобы весь текст уместился и не было бы свободного места.
Как макросом заставить эту фигуру вписать в себя - текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки ?
Здравствуйте, уважаемые форумчане.
Помогите разобраться с непростым вопросом.
В ячейку C8 вписан текст - высотой шрифта 10. Рядом находится фигура "Прямоугольник 2". Известно что после вставки текста в фигуру - ее размеры приходится подгонять, чтобы весь текст уместился и не было бы свободного места.
Как макросом заставить эту фигуру вписать в себя - текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки ?mv6677
Доброе время суток. Возможный подход. Сначала подгоняем текст в ячейке с настроенным форматом шрифта 1. Устанавливаем переносить по словам. 2. Изменяем ширину с небольшим шагом 3. Range("A1").EntireRow.AutoFit 4. По высоте ячейки определяем получилось ли две строки, если нет повторяем с 2 5. Учитывая отступы в фигуре при вводе текста, определяем размер фигуры с учётом размера ячейки. 6. Задаём для текста формат и вводим в фигуру. 7. Возможно даём некоторую поправку на + по ширине и высоте фигуры. Как-то так. Успехов.
Доброе время суток. Возможный подход. Сначала подгоняем текст в ячейке с настроенным форматом шрифта 1. Устанавливаем переносить по словам. 2. Изменяем ширину с небольшим шагом 3. Range("A1").EntireRow.AutoFit 4. По высоте ячейки определяем получилось ли две строки, если нет повторяем с 2 5. Учитывая отступы в фигуре при вводе текста, определяем размер фигуры с учётом размера ячейки. 6. Задаём для текста формат и вводим в фигуру. 7. Возможно даём некоторую поправку на + по ширине и высоте фигуры. Как-то так. Успехов.anvg
А я на чём-нибудь настаивал? Можно как вариант, изучить TextFrame, TextFrame2. Задать текст, разбитый на две строки приблизительно равной по символам длины, (vbLf) и установить свойство AutoSize в msoAutoSizeShapeToFitText. По экспериментируйте.
А я на чём-нибудь настаивал? Можно как вариант, изучить TextFrame, TextFrame2. Задать текст, разбитый на две строки приблизительно равной по символам длины, (vbLf) и установить свойство AutoSize в msoAutoSizeShapeToFitText. По экспериментируйте.anvg
Это вы серьёзно? Ну, давайте спросим макрорекордер [vba]
Код
Sub Макрос1() ' ' Макрос1 Макрос '
' ActiveSheet.Shapes.AddShape(msoShapeRectangle, 207.75, 99.75, 72, 72).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _ "Текст автофигуры" With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 16). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignLeft End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 16).Font .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1 .Fill.ForeColor.TintAndShade = 0 .Fill.ForeColor.Brightness = 0 .Fill.Transparency = 0 .Fill.Solid .Size = 11 .Name = "+mn-lt" End With Range("F13").Select End Sub
[/vba]Как видите TextFrame2 в наличии Как на мой взгляд, самый простой путь это ячейка исходно большого размера, с двухстрочным содержимым и дважды применённый AutoFit по строке и столбцу для получения первого приближения размера. Ячейку можно использовать и на временном листе, не обязательно на том, что в вашем файле. У TextFrame2 одна проблема - размер подгоняется только по вертикали. Впрочем, можете попробовать и через Word с резиновой одноячеечной таблицей, ну, или самое крутое Winapi get string width in pixels Честно говоря, без вашего участия тема для меня становится не интересной. Одно дело помогать, другое делать полностью за вас.
Это вы серьёзно? Ну, давайте спросим макрорекордер [vba]
Код
Sub Макрос1() ' ' Макрос1 Макрос '
' ActiveSheet.Shapes.AddShape(msoShapeRectangle, 207.75, 99.75, 72, 72).Select Selection.ShapeRange(1).TextFrame2.TextRange.Characters.Text = _ "Текст автофигуры" With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 16). _ ParagraphFormat .FirstLineIndent = 0 .Alignment = msoAlignLeft End With With Selection.ShapeRange(1).TextFrame2.TextRange.Characters(1, 16).Font .NameComplexScript = "+mn-cs" .NameFarEast = "+mn-ea" .Fill.Visible = msoTrue .Fill.ForeColor.ObjectThemeColor = msoThemeColorLight1 .Fill.ForeColor.TintAndShade = 0 .Fill.ForeColor.Brightness = 0 .Fill.Transparency = 0 .Fill.Solid .Size = 11 .Name = "+mn-lt" End With Range("F13").Select End Sub
[/vba]Как видите TextFrame2 в наличии Как на мой взгляд, самый простой путь это ячейка исходно большого размера, с двухстрочным содержимым и дважды применённый AutoFit по строке и столбцу для получения первого приближения размера. Ячейку можно использовать и на временном листе, не обязательно на том, что в вашем файле. У TextFrame2 одна проблема - размер подгоняется только по вертикали. Впрочем, можете попробовать и через Word с резиновой одноячеечной таблицей, ну, или самое крутое Winapi get string width in pixels Честно говоря, без вашего участия тема для меня становится не интересной. Одно дело помогать, другое делать полностью за вас.anvg
anvg, посмотрел ваш макрос. И у меня возник вопрос. Как измерить длину половины строки, причем такой половины - которая включает слова целиком.
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь". Ее арифметическая половина - примерно на слове "пять". Но формально - это слово должно быть включено целиком - то есть формальная половина - это "Один два три четыре пять".
Вот как измерить эту половину , чтобы подогнать под нее ширину фигуры ?
anvg, посмотрел ваш макрос. И у меня возник вопрос. Как измерить длину половины строки, причем такой половины - которая включает слова целиком.
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь". Ее арифметическая половина - примерно на слове "пять". Но формально - это слово должно быть включено целиком - то есть формальная половина - это "Один два три четыре пять".
Вот как измерить эту половину , чтобы подогнать под нее ширину фигуры ?mv6677
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь" .... то есть формальная половина - это "Один два три четыре пять".
Точно? А давайте проверим.
По вашему Один два три четыре пять (24 символа) шесть семь восемь (17 символов)
На мой взгляд Один два три четыре (19 символов) пять шесть семь восемь (22 символа)
Что ближе? Или вы с учётом разнопеременной ширины символов и расстояний между ними, как это принято в типографии? Если исходить из равной ширины букв и расстояний между ними, то можно разбивать текст на пополам такой функцией
[vba]
Код
Public Function ToTwoLines(ByVal thisText As String) As String Dim subs() As String Dim vMiddle As Long, i As Long, curLen As Long Dim curPos As Long, curDiff As Long, vFrom As Long thisText = Application.WorksheetFunction.Trim(thisText) subs = Split(thisText, " ") curDiff = Len(thisText) vMiddle = curDiff \ 2 vFrom = LBound(subs) curLen = Len(subs(vFrom)) For i = vFrom + 1 To UBound(subs) - 1 curLen = curLen + Len(subs(i)) + 1 If Abs(curLen - vMiddle) < curDiff Then curPos = i: curDiff = Abs(curLen - vMiddle) Else Exit For End If Next thisText = subs(vFrom) For i = vFrom + 1 To curPos thisText = thisText & " " & subs(i) Next thisText = thisText & vbLf & subs(curPos + 1) For i = curPos + 2 To UBound(subs) thisText = thisText & " " & subs(i) Next ToTwoLines = thisText End Function
Так это и есть основная проблема вашей задачи. Я предлагаю решать через AutoFit ячейки. Вы хотите чего-то своего. Но чего-то конкретного не предлагаете. В методах и свойствах TextFrame2 нет ничего, чтобы давало ширину/высоту текста. AutoSize позволяет лишь подбирать высоту под неизменный текст, но не ширину. Если вам нужны вычисления ширины текста под заданный шрифт, то WinAPI - осталось найти и, разобравшись, применить.
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь" .... то есть формальная половина - это "Один два три четыре пять".
Точно? А давайте проверим.
По вашему Один два три четыре пять (24 символа) шесть семь восемь (17 символов)
На мой взгляд Один два три четыре (19 символов) пять шесть семь восемь (22 символа)
Что ближе? Или вы с учётом разнопеременной ширины символов и расстояний между ними, как это принято в типографии? Если исходить из равной ширины букв и расстояний между ними, то можно разбивать текст на пополам такой функцией
[vba]
Код
Public Function ToTwoLines(ByVal thisText As String) As String Dim subs() As String Dim vMiddle As Long, i As Long, curLen As Long Dim curPos As Long, curDiff As Long, vFrom As Long thisText = Application.WorksheetFunction.Trim(thisText) subs = Split(thisText, " ") curDiff = Len(thisText) vMiddle = curDiff \ 2 vFrom = LBound(subs) curLen = Len(subs(vFrom)) For i = vFrom + 1 To UBound(subs) - 1 curLen = curLen + Len(subs(i)) + 1 If Abs(curLen - vMiddle) < curDiff Then curPos = i: curDiff = Abs(curLen - vMiddle) Else Exit For End If Next thisText = subs(vFrom) For i = vFrom + 1 To curPos thisText = thisText & " " & subs(i) Next thisText = thisText & vbLf & subs(curPos + 1) For i = curPos + 2 To UBound(subs) thisText = thisText & " " & subs(i) Next ToTwoLines = thisText End Function
Так это и есть основная проблема вашей задачи. Я предлагаю решать через AutoFit ячейки. Вы хотите чего-то своего. Но чего-то конкретного не предлагаете. В методах и свойствах TextFrame2 нет ничего, чтобы давало ширину/высоту текста. AutoSize позволяет лишь подбирать высоту под неизменный текст, но не ширину. Если вам нужны вычисления ширины текста под заданный шрифт, то WinAPI - осталось найти и, разобравшись, применить.anvg
Можно попробовать применить старую добрую команду Range.Justify, которая при заданной ширине столбца бьёт исходную строку на подстроки и располагает их в ячейках ниже исходной. Количество этих ячеек (а значит и подстрок) можно сосчитать через Range.CurrentRegion.Rows.Count. Разумеется, всё это будут некоторые вспомогательные вычисления, которые лучше и проще выполнять на пустом доп.листе, возможно, скрытом.
На скорую руку у меня получился следующий макрос подгона ширины столбца до состояния, когда исходная строка бьётся ровно на две строки в приблизительный момент перехода от трёх строк к двум. "Приблизительный" - потому что лучше в алгоритме было бы применить, например, метод половинного деления (дихотомии) для более точного расчета точки перехода "из 3 в 2". Но это уже получилось бы не на совсем "скорую руку", поэтому я пока ограничился простым циклом.
[vba]
Код
Sub IntoTwoLines() Dim txt As String Dim wdt As Double Dim wdtMax As Double Dim wdtMin As Double
txt = "Один два три четыре пять шесть семь восемь"
Application.DisplayAlerts = False For wdt = wdtMin To wdtMax Step 1 Debug.Print wdt Columns("A:A").ColumnWidth = wdt Range("A1").CurrentRegion.Clear Range("A1").Value = txt Range("A1").Justify If Range("A1").CurrentRegion.Rows.Count = 2 Then Exit For Next Application.DisplayAlerts = True End Sub
[/vba]
Предполагается, что далее получившаяся ширина колонки листа станет шириной фигуры "Прямоугольник", а суммарная высота двух строк листа - высотой "Прямоугольника" соответственно.
Для справки: Через пользовательский интерфейс Excel команда Range.Justify вызывается из довольно запрятанного места: Главная \ Редактирование \ Заполнить \ Выровнять.
Можно попробовать применить старую добрую команду Range.Justify, которая при заданной ширине столбца бьёт исходную строку на подстроки и располагает их в ячейках ниже исходной. Количество этих ячеек (а значит и подстрок) можно сосчитать через Range.CurrentRegion.Rows.Count. Разумеется, всё это будут некоторые вспомогательные вычисления, которые лучше и проще выполнять на пустом доп.листе, возможно, скрытом.
На скорую руку у меня получился следующий макрос подгона ширины столбца до состояния, когда исходная строка бьётся ровно на две строки в приблизительный момент перехода от трёх строк к двум. "Приблизительный" - потому что лучше в алгоритме было бы применить, например, метод половинного деления (дихотомии) для более точного расчета точки перехода "из 3 в 2". Но это уже получилось бы не на совсем "скорую руку", поэтому я пока ограничился простым циклом.
[vba]
Код
Sub IntoTwoLines() Dim txt As String Dim wdt As Double Dim wdtMax As Double Dim wdtMin As Double
txt = "Один два три четыре пять шесть семь восемь"
Application.DisplayAlerts = False For wdt = wdtMin To wdtMax Step 1 Debug.Print wdt Columns("A:A").ColumnWidth = wdt Range("A1").CurrentRegion.Clear Range("A1").Value = txt Range("A1").Justify If Range("A1").CurrentRegion.Rows.Count = 2 Then Exit For Next Application.DisplayAlerts = True End Sub
[/vba]
Предполагается, что далее получившаяся ширина колонки листа станет шириной фигуры "Прямоугольник", а суммарная высота двух строк листа - высотой "Прямоугольника" соответственно.
Для справки: Через пользовательский интерфейс Excel команда Range.Justify вызывается из довольно запрятанного места: Главная \ Редактирование \ Заполнить \ Выровнять.Gustav