Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel (архив)
Страницы: 1
RSS
Глюк Excel 2007 - картинки смещаются относительно ячеек
 
#1
06.11.2009 13:28:36
Уже второй раз сталкиваюсь с этим.  
Но в этот раз макрос нужен именно под 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 подобные макросы работают идеально.  
 
Кто что посоветует?
 
 
 
#2
06.11.2009 21:14:11
Do you speak English?      
http://www.eggheadcafe.com/software/aspnet/29418574/inserting-pictures-in-exc.aspx  
Здесь о том же...
 
 
 
#3
06.11.2009 21:16:54
на всякий случай (если ссылка не откроется)      
Код
Dim myPict As Picture   
   
With ActiveCell   
Set myPict = .Parent.Pictures.Insert(filename)   
myPict.Top = .Top   
myPict.Left = .Left   
myPict.Placement = xlMoveAndSize   
End With
 
 
 
#4
07.11.2009 12:47:46
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
 
 
 
#5
19.05.2011 14:01:08
Такое происходит, если масштаб печати не 100.  
Если масштаб меньше, то все сжимается, а картинки остаются на своих местах.
 
 
 
#6
29.01.2017 17:28:40
Похожее
 
 
 
Страницы: 1
Наверх