Доброго времени суток
Проблемка в следующем
есть файл Excel в котором в качестве шаблона документа используется рисунок (болтается на заднем фоне)
соответственно размеры ячеек зафиксированны и изменять их нельзя
в настройках ячеек текст можно переносить по словам
можно изменять размер шрифта
задача одна вписать текст в ячейку не только по ширине (это я нашел как) но и по высоте с наименьшими потерями в размере шрифта
и все это нужно сделать на VBA
Заранее благодарен

Уже разобрался.......
погуглил - нашел код для акса - не много переделал и получил результат
Жена довольна

а про excel даже и не знаю чего сказать - так юзаю на начальном уровне
все равно - спасибо

код - вот

Private Type SIZE
cx As Long
cy As Long
End Type

Private Declare Function GetDC Lib "user32" _
(ByVal hwnd As Long) As Long
Private Declare Function ReleaseDC Lib "user32" _
(ByVal hwnd As Long, ByVal hdc As Long) As Long
Private Declare Function GetDeviceCaps Lib "gdi32" _
(ByVal hdc As Long, ByVal nIndex As Long) As Long
Private Declare Function GetTextExtentPoint32 Lib "gdi32" _
Alias "GetTextExtentPoint32A" _
(ByVal hdc As Long, ByVal lpsz As String, _
ByVal cbString As Long, lpSize As SIZE) As Long
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" _
(ByVal hwnd As Long, ByVal wMsg As Long, _
ByVal wParam As Long, lParam As Any) As Long
Private Declare Function SelectObject Lib "gdi32" _
(ByVal hdc As Long, ByVal hObject As Long) As Long
Private Declare Function CreateFont Lib "gdi32" Alias "CreateFontA" _
(ByVal h As Long, ByVal W As Long, ByVal E As Long, _
ByVal O As Long, ByVal W As Long, ByVal I As Long, _
ByVal u As Long, ByVal S As Long, ByVal C As Long, _
ByVal OP As Long, ByVal CP As Long, ByVal Q As Long, _
ByVal PAF As Long, ByVal F As String) As Long
Private Declare Function DeleteObject Lib "gdi32" _
(ByVal hObject As Long) As Long
'измененный пример Игоря Макеева - подгоняет размер шрифта под размер контрола
Private Function fontChange(Width2 As Long, Height2 As Long, asd As String) As Long
fontChange = 10
Dim dc As Long
Dim lPixelPerInchX As Long, lbwt As Long, lbwp As Long
Dim lPixelPerInchY As Long
Dim lFont As Long, lFontOld As Long, splen As Long
Dim spleny As Long
Dim sz As SIZE
Dim lH As Long
aaa:
Const LOGPIXELSY = 90
Const LOGPIXELSX = 88
dc = GetDC(0)
lPixelPerInchX = GetDeviceCaps(dc, LOGPIXELSX)
lPixelPerInchY = GetDeviceCaps(dc, LOGPIXELSY)
lFont = CreateFont(-(fontChange * GetDeviceCaps(dc, LOGPIXELSY)) / 72, _
0, 0, 0, 400, 0, 0, 0, _
1, 0, 0, 0, 2, "Times New Roman")
lFontOld = SelectObject(dc, lFont)
GetTextExtentPoint32 dc, "Ж", 1, sz
splen = sz.cx
spleny = sz.cy \ 3
GetTextExtentPoint32 dc, asd, Len(asd), sz
SelectObject dc, lFontOld
DeleteObject lFont
ReleaseDC 0, dc
Dim lk As Long
If sz.cy = 0 Then
lk = 1
Else
lk = (Height2 \ ((sz.cy + spleny) / lPixelPerInchY * 1440))
End If
If lk = 0 Then lk = 1
lbwt = ((sz.cx + splen) / lPixelPerInchX) * 1440 / lk
lH = sz.cy
If Width2 < lbwt And fontChange > 2 Then
fontChange = fontChange - 1
GoTo aaa:
End If

End Function


маленькие пояснения
Width2 (ширина ячейки в твипсах)
Height2 (высота ячейки в твипсах)
asd - собственно текст
там в коде есть цифирка 400 - это свойство FontWeight
и "Times New Roman" - свойство FontName

в результате отрабатывания функции на свет появляется число - размер шрифта которое присваиваем свойству FontSize (для excel - Font.Size)
вот и все