Здравствуйте! Прошу помощи в решении следующей задачи. Я создаю отчет для печати данных в бланк приложения к диплому о высшем образовании. В бланке на первой странице есть область высотой 4 см для вывода информации о курсовиках. Если информация не помещается в этом месте, ее переносят в самый конец документа. Информация помещена в подчиненный отчет, расширяться я ему запретила. Подскажите, возможно ли определить, помещается выводимый текст в заданную область или нет?

Шрифт я знаю, я сама его устанавливаю, а как узнать число строк, на которое растянулся текст?

http://hiprog.com/forum/read.php?id_forum=1&id_theme=7272&page=1

вот и пример тама может поможет

разделить высоту области вывода на высоту шрифта :)

А попробуй ограничить количество строк. Коли это бланк, то и вдолби туда определенное количество строк, в пределах которых можно вбивать информацию.

Надо брать моноширный шрифт для этого поля.
И функцией Len() считать буквы и переносить целые слова на новую строку. Слова отделены пробелами.
Если количество символов более определённого (например 100) тогда ищем в строке ближайший пробел идя назад по строке, отсчитанное количество символов переносим на следующую строку.
Блин проще на примере:
значит строка должна быть не более 100 символов
А у нас она 150
тогда
в первую строку мы отрезаем 100 символов
и начинаем считать сколько ещё отнять до первого попавшегося пробела, например получаем 4 символа
Значит первая строка = 100 - 4 = 96 символов
остальные переносим на следующую строку.
Там так же проверяем и так пока Len(STROKA) =0

Тем более. Бланк строгой отчетности имеет определенное, количество строк стало быть. Заполнять форму и печатать сразу из формы, а не переводить в отчет. (печать данных формы). А форму сделать по образцу и подобию бланка. К тому же есть один плюс. Т.К. бланки печатают на станке, разные партии имеют разные обрезки, а стало быть и разные расположения нужных строк. Печатая из формы, можно делать корректуру расположения полей. (вызвать форму настройки, и с нее кнопками корректировать вправо-влево, вверх-вниз необходимые строки. Сами строки выполнить как говорит час. Да и надо ли? Там ведь все сразу видно будет.

Правда если там большое свободное поле, куда надо вместить столько зачетов, сколько сдал студент, то... По мере увеличения информации должен увеличиваться масштаб, а стало быть, чем больше записей, тем меньше шрифт... (линза прилагается)

Public Function SetFont2(con As Control, Optional maxFontSize As Integer = 14, Optional minFontSize As Integer = 6)     On Error Resume Next     Dim Cch As Long     Dim MaxWidthCch As Long     Dim dx As Long     Dim dy As Long     Dim txt As String     Dim tmpFontSize As Integer     Dim Rows As Integer     Dim WidthControl As Long     Dim HeightControl As Long     'только для TextBox или Label     'If Not (con.ControlType = acTextBox Or con.ControlType = acLabel) Then Exit Function     'ширина и высота контрола     WidthControl = con.Width - (con.LeftMargin + con.RightMargin)     HeightControl = con.Height - (con.TopMargin + con.BottomMargin)     'получим размер всей строки     Select Case con.ControlType         Case acTextBox             txt = con.Value         Case acLabel             txt = con.Caption     End Select         WizHook.key = 51488399 'инит визхука     tmpFontSize = maxFontSize     Do         If Not WizHook.TwipsFromFont(con.FontName, tmpFontSize, con.FontWeight, con.FontItalic, _                                  con.FontUnderline, Cch, txt, MaxWidthCch, _                                  dx, dy) Then Exit Function         'получаем число строк                   Rows = dx / WidthControl        '  ''Debug.print tmpFontSize, con.FontName, tmpFontSize, dx, WidthControl         If Rows >= 1 Then 'в одну строку не влезли :(             'If (Rows * dy + ((Rows - 1) * dy / 3)) > HeightControl Then                 'уменьшаем фонт                 tmpFontSize = tmpFontSize - 1           '      ''Debug.print "-", tmpFontSize, con.FontName, tmpFontSize             Else                 'Все четко!                 Exit Do             'End If         End If     Loop While tmpFontSize > minFontSize     con.FontSize = tmpFontSize End Function

Пример

Private Sub Имяраздела_Format(Cancel As Integer, FormatCount As Integer) Me.NaimPrice.FontSize = 12 ' - устанавливаем шрифт SetFont2 Me.NaimPrice, 12, 6 End Sub

была у меня обратная задача
запихать текст в поле путем изменения шрифта
функция тут
http://hiprog.com/forum/read.php?id_forum=4&id_theme=7738&page=1

Прошу прощения, что надолго исчезла с форума.
Kot_k_k, проблема в том, что текст нужно переносить по словам, а не по символам, а число слов, влезающих в строку, посчитать, конечно, тоже можно, но уже значительно труднее, чем число символов.
Примеры с подбором шрифта видела, собираюсь применить некоторые имеющиеся в них приемы. Но сам по себе подбор шрифта не является решением моей задачи.

... я должна оценить именно число строк, которое получится из введенного текста...

С некоторой погрешностью, можно попытаться сделать это как-то так
(на скорую руку, сильно не тестил, левые правые отступы в контроле не учитывал):

Public Function GetRowsCount(ctrl As Control, text As String) As Integer     Dim Words, i As Integer, temp As String, temp2 As String          If GetTextWidth(ctrl, text) <= ctrl.Width Then 'текст поместился целиком, без переносов         GetRowsCount = GetRowsCount + 1     Else         If InStr(1, text, " ") = 0 Then 'Последнее слово (не поместилось)             GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, GetParthWord(ctrl, text) + 1))         Else 'не последнее слово             Words = Split(text, " ")             If GetTextWidth(ctrl, Words(0) & " ") > ctrl.Width Then 'первое слово не поместилось                 GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, GetParthWord(ctrl, text) + 1))             Else 'первое слово поместилось                 'пытаемся добавить слово                 temp = Words(0) & " "                 Do While i <= UBound(Words) And GetTextWidth(ctrl, temp) <= ctrl.Width                     i = i + 1                     temp2 = temp                     temp = temp & Words(i) & " "                 Loop                 GetRowsCount = GetRowsCount + 1 + GetRowsCount(ctrl, Mid(text, Len(temp2) + 1))             End If         End If      End If End Function Private Function GetTextWidth(ctrl As Control, text As String) As Long     Dim wzCch As Long     Dim wzMaxWidthCch As Long     Dim wzdx As Long     Dim wzdy As Long        WizHook.Key = 51488399     With ctrl         WizHook.TwipsFromFont .FontName, .FontSize, .FontWeight, _                           .FontItalic, .FontUnderline, wzCch, _                           text, wzMaxWidthCch, wzdx, wzdy     End With     GetTextWidth = wzdx End Function ' Здесь бывает врет на единичку Private Function GetParthWord(ctrl As Control, text As String) As Integer     Dim i As Integer          Do While GetTextWidth(ctrl, Mid(text, 1, Len(text) - i)) > ctrl.Width         i = i + 1     Loop     GetParthWord = Len(text) - i End Function