Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Как подогнать размер фигуры - под вписанный текст - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как подогнать размер фигуры - под вписанный текст (Макросы/Sub)
Как подогнать размер фигуры - под вписанный текст
mv6677 Дата: Пятница, 22.09.2017, 19:30 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
Здравствуйте, уважаемые форумчане.

Помогите разобраться с непростым вопросом.

В ячейку C8 вписан текст - высотой шрифта 10.
Рядом находится фигура "Прямоугольник 2".
Известно что после вставки текста в фигуру - ее размеры приходится подгонять, чтобы весь текст уместился и не было бы свободного места.

Как макросом заставить эту фигуру вписать в себя - текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки ?
К сообщению приложен файл: 234231.xls (34.0 Kb)
 
Ответить
СообщениеЗдравствуйте, уважаемые форумчане.

Помогите разобраться с непростым вопросом.

В ячейку C8 вписан текст - высотой шрифта 10.
Рядом находится фигура "Прямоугольник 2".
Известно что после вставки текста в фигуру - ее размеры приходится подгонять, чтобы весь текст уместился и не было бы свободного места.

Как макросом заставить эту фигуру вписать в себя - текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки ?

Автор - mv6677
Дата добавления - 22.09.2017 в 19:30
anvg Дата: Пятница, 22.09.2017, 19:46 | Сообщение № 2
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
Доброе время суток.
Возможный подход. Сначала подгоняем текст в ячейке с настроенным форматом шрифта
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
Дата добавления - 22.09.2017 в 19:46
mv6677 Дата: Пятница, 22.09.2017, 20:17 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
anvg, без изменения размеров ячейки
 
Ответить
Сообщениеanvg, без изменения размеров ячейки

Автор - mv6677
Дата добавления - 22.09.2017 в 20:17
anvg Дата: Пятница, 22.09.2017, 21:44 | Сообщение № 4
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
без изменения размеров ячейки
А я на чём-нибудь настаивал?
Можно как вариант, изучить TextFrame, TextFrame2. Задать текст, разбитый на две строки приблизительно равной по символам длины, (vbLf) и установить свойство AutoSize в msoAutoSizeShapeToFitText. По экспериментируйте.
 
Ответить
Сообщение
без изменения размеров ячейки
А я на чём-нибудь настаивал?
Можно как вариант, изучить TextFrame, TextFrame2. Задать текст, разбитый на две строки приблизительно равной по символам длины, (vbLf) и установить свойство AutoSize в msoAutoSizeShapeToFitText. По экспериментируйте.

Автор - anvg
Дата добавления - 22.09.2017 в 21:44
mv6677 Дата: Суббота, 23.09.2017, 08:56 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
изучить TextFrame


Я спрашивал про автофигуру, а не про TextFrame.
 
Ответить
Сообщение
изучить TextFrame


Я спрашивал про автофигуру, а не про TextFrame.

Автор - mv6677
Дата добавления - 23.09.2017 в 08:56
anvg Дата: Суббота, 23.09.2017, 09:38 | Сообщение № 6
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
Я спрашивал про автофигуру, а не про TextFrame.
Это вы серьёзно? Ну, давайте спросим макрорекордер
[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
Честно говоря, без вашего участия тема для меня становится не интересной. Одно дело помогать, другое делать полностью за вас.
 
Ответить
Сообщение
Я спрашивал про автофигуру, а не про TextFrame.
Это вы серьёзно? Ну, давайте спросим макрорекордер
[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
Дата добавления - 23.09.2017 в 09:38
mv6677 Дата: Суббота, 23.09.2017, 11:51 | Сообщение № 7
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
anvg, посмотрел ваш макрос.
И у меня возник вопрос.
Как измерить длину половины строки, причем такой половины - которая включает слова целиком.

Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь".
Ее арифметическая половина - примерно на слове "пять".
Но формально - это слово должно быть включено целиком - то есть формальная половина - это "Один два три четыре пять".

Вот как измерить эту половину , чтобы подогнать под нее ширину фигуры ?
 
Ответить
Сообщениеanvg, посмотрел ваш макрос.
И у меня возник вопрос.
Как измерить длину половины строки, причем такой половины - которая включает слова целиком.

Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь".
Ее арифметическая половина - примерно на слове "пять".
Но формально - это слово должно быть включено целиком - то есть формальная половина - это "Один два три четыре пять".

Вот как измерить эту половину , чтобы подогнать под нее ширину фигуры ?

Автор - mv6677
Дата добавления - 23.09.2017 в 11:51
anvg Дата: Суббота, 23.09.2017, 14:53 | Сообщение № 8
Группа: Друзья
Ранг: Ветеран
Сообщений: 581
Репутация: 271 ±
Замечаний: 0% ±

2016, 365
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь" .... то есть формальная половина - это "Один два три четыре пять".
Точно? А давайте проверим.

По вашему
Один два три четыре пять (24 символа)
шесть семь восемь (17 символов)

На мой взгляд
Один два три четыре (19 символов)
пять шесть семь восемь (22 символа)

Что ближе? Или вы с учётом разнопеременной ширины символов и расстояний между ними, как это принято в типографии? Если исходить из равной ширины букв и расстояний между ними, то можно разбивать текст на пополам такой функцией


Вот как измерить эту половину
Так это и есть основная проблема вашей задачи. Я предлагаю решать через AutoFit ячейки. Вы хотите чего-то своего. Но чего-то конкретного не предлагаете. В методах и свойствах TextFrame2 нет ничего, чтобы давало ширину/высоту текста. AutoSize позволяет лишь подбирать высоту под неизменный текст, но не ширину. Если вам нужны вычисления ширины текста под заданный шрифт, то WinAPI - осталось найти и, разобравшись, применить.
 
Ответить
Сообщение
Вот к примеру строка выглядит так: "Один два три четыре пять шесть семь восемь" .... то есть формальная половина - это "Один два три четыре пять".
Точно? А давайте проверим.

По вашему
Один два три четыре пять (24 символа)
шесть семь восемь (17 символов)

На мой взгляд
Один два три четыре (19 символов)
пять шесть семь восемь (22 символа)

Что ближе? Или вы с учётом разнопеременной ширины символов и расстояний между ними, как это принято в типографии? Если исходить из равной ширины букв и расстояний между ними, то можно разбивать текст на пополам такой функцией


Вот как измерить эту половину
Так это и есть основная проблема вашей задачи. Я предлагаю решать через AutoFit ячейки. Вы хотите чего-то своего. Но чего-то конкретного не предлагаете. В методах и свойствах TextFrame2 нет ничего, чтобы давало ширину/высоту текста. AutoSize позволяет лишь подбирать высоту под неизменный текст, но не ширину. Если вам нужны вычисления ширины текста под заданный шрифт, то WinAPI - осталось найти и, разобравшись, применить.

Автор - anvg
Дата добавления - 23.09.2017 в 14:53
Gustav Дата: Суббота, 23.09.2017, 14:55 | Сообщение № 9
Группа: Друзья
Ранг: Участник клуба
Сообщений: 2697
Репутация: 1123 ±
Замечаний: 0% ±

начинал с Excel 4.0, видел 2.1
Можно попробовать применить старую добрую команду 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 = "Один два три четыре пять шесть семь восемь"
    
    Range("A1").Value = txt
    Columns("A:A").EntireColumn.AutoFit
    wdtMax = Columns("A:A").ColumnWidth
    wdtMin = 0.33 * wdtMax
    
    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 вызывается из довольно запрятанного места: Главная \ Редактирование \ Заполнить \ Выровнять.


МОИ: Ник, Tip box: 41001663842605
 
Ответить
СообщениеМожно попробовать применить старую добрую команду 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 = "Один два три четыре пять шесть семь восемь"
    
    Range("A1").Value = txt
    Columns("A:A").EntireColumn.AutoFit
    wdtMax = Columns("A:A").ColumnWidth
    wdtMin = 0.33 * wdtMax
    
    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
Дата добавления - 23.09.2017 в 14:55
mv6677 Дата: Суббота, 23.09.2017, 19:10 | Сообщение № 10
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
Gustav, все ясно.
Я понял вашу хитроумную идею.
Спасибо за совет.
 
Ответить
СообщениеGustav, все ясно.
Я понял вашу хитроумную идею.
Спасибо за совет.

Автор - mv6677
Дата добавления - 23.09.2017 в 19:10
InExSu Дата: Воскресенье, 24.09.2017, 11:08 | Сообщение № 11
Группа: Друзья
Ранг: Ветеран
Сообщений: 648
Репутация: 96 ±
Замечаний: 0% ±

Excel 2010, 365
Привет!
текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки

Понял и сделал по рабоче-крестьянски. Нажать на кнопку "кнопка"
К сообщению приложен файл: mv6677_InExSu_.xls (45.5 Kb)


Разработчик Битрикс24 php, Google Apps Script, VBA Excel Windows/Mac
 
Ответить
СообщениеПривет!
текст из ячейки и подогнать ширину и высоту этой фигуры - так чтобы уместился весь текст, записанный ровно в две строки

Понял и сделал по рабоче-крестьянски. Нажать на кнопку "кнопка"

Автор - InExSu
Дата добавления - 24.09.2017 в 11:08
mv6677 Дата: Воскресенье, 24.09.2017, 23:23 | Сообщение № 12
Группа: Пользователи
Ранг: Участник
Сообщений: 71
Репутация: 3 ±
Замечаний: 0% ±

Excel 2013
InExSu, работает идеально.
Огромное спасибо.
 
Ответить
СообщениеInExSu, работает идеально.
Огромное спасибо.

Автор - mv6677
Дата добавления - 24.09.2017 в 23:23
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Как подогнать размер фигуры - под вписанный текст (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!