Страницы: 1
RSS
Глюк Excel 2007 - картинки смещаются относительно ячеек
 
Уже второй раз сталкиваюсь с этим.  
Но в этот раз макрос нужен именно под Excel 2007 - поэтому вынужден искать решение проблемы.  
 
Суть проблемы:    
вставляю макросом картинки из файлов на лист таким кодом:  
Код
Function ВставитьКартинку(ByRef cell As Range, ByVal Pic As String) As Boolean   
    ' если картинка вставлена успешно, возвращает TRUE   
    On Error Resume Next: Err.Clear   
    Dim ph As Picture: Set ph = cell.Parent.Pictures.Insert(Pic)   
    ВставитьКартинку = Err.Number = 0   
    ph.Top = cell.Top: ph.Left = cell.Left: k = ph.Width / ph.Height   
    ph.Width = cell.Width: ph.Height = ph.Width / k   
    cell.EntireRow.RowHeight = ph.Height   
End Function   

В Excel 2003 всё работает замечательно - все картинки полностью совпадают по размерам с ячейками.  
 
В Excel 2007 каждая из вставляемых картинов размещается чуть ниже, чем надо.  
И чем ниже картинка на листе, тем больше смещение от ячейки.  
Т.е. в первой строке картинки вставляются точно, в 10-й - с небольшим сдвигом вниз (около миллиметра), в 50-й - сдвиг достигает сантиметра.  
 
Впечатление такое, что в Excel 2003 и 2007 по-разному вычисляется свойство .Top для картинов и\или ячеек.  

Ведь я помещаю картинку точно в левый верхний угол ячейки:  
Код
ph.Top = cell.Top: ph.Left = cell.Left  
   
Ещё раз замечу - в Excel 2003 подобные макросы работают идеально.  
 
Кто что посоветует?
 
Do you speak English?      
http://www.eggheadcafe.com/software/aspnet/29418574/inserting-pictures-in-exc.aspx  
Здесь о том же...
 
на всякий случай (если ссылка не откроется)      
Код
Dim myPict As Picture   
   
With ActiveCell   
Set myPict = .Parent.Pictures.Insert(filename)   
myPict.Top = .Top   
myPict.Left = .Left   
myPict.Placement = xlMoveAndSize   
End With
 
VovaK, спасибо большое за ссылку.  Правда, решения проблемы там нет:)  
 
Не стал сильно заморачиваться с поиском решения (поскольку, я так понял, проблема решается установкой сервиспаков), и сотворил вот что:  
Код
Function ВставитьКартинку(ByRef cell As Range, ByVal Pic As String) As Boolean   
    ' если картинка вставлена успешно, возвращает TRUE   
    On Error Resume Next: Err.Clear   
    Dim ph As Picture: Set ph = cell.Parent.Pictures.Insert(Pic)   
    ВставитьКартинку = Err.Number = 0   
    ph.Placement = xlMoveAndSize ' не помогает :(   
   
    ph.Top = cell.Top + 0.5 + (Val(Application.Version) = 12) * 0.1 * cell.Row   
' теперь намного точнее - смещение картинок практически незаметно :)   
   
 ph.Left = cell.Left   
    k = ph.Width / ph.Height   
    ph.Width = cell.Width: ph.Height = ph.Width / k   
    cell.EntireRow.RowHeight = ph.Height   
   
    If Val(Application.Version) = 12 Then cell.Borders.LineStyle = xlNone   
' убираем рамку на ячейке, поскольку маленькая неточность всё же присутствует.   
End Function
 
Такое происходит, если масштаб печати не 100.  
Если масштаб меньше, то все сжимается, а картинки остаются на своих местах.
 
Похожее
Страницы: 1
Наверх