Страницы: 1
RSS
Глюк Excel 2007 - картинки смещаются относительно ячеек
 
Уже второй раз сталкиваюсь с этим.  
Но в этот раз макрос нужен именно под Excel 2007 - поэтому вынужден искать решение проблемы.  
 
Суть проблемы:    
вставляю макросом картинки из файлов на лист таким кодом:  
Код
1
2
3
4
5
6
7
8
9
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 для картинов и\или ячеек.  

Ведь я помещаю картинку точно в левый верхний угол ячейки:  
Код
1
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  
Здесь о том же...
 
на всякий случай (если ссылка не откроется)      
Код
1
2
3
4
5
6
7
8
Dim myPict As Picture  
    
With ActiveCell  
Set myPict = .Parent.Pictures.Insert(filename)  
myPict.Top = .Top  
myPict.Left = .Left  
myPict.Placement = xlMoveAndSize  
End With
 
VovaK, спасибо большое за ссылку.  Правда, решения проблемы там нет:)  
 
Не стал сильно заморачиваться с поиском решения (поскольку, я так понял, проблема решается установкой сервиспаков), и сотворил вот что:  
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
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
Читают тему
Наверх
Loading...