Добрый день. Проблема следующая:
Программа формирует прайс лист и добавляет фото к позициям. Когда сохраняю в пдф проблем нет, но клиенты просят в эксель, но в итоге вместо рисунков видят "не удается отобразить связанный рисунок и т.д...". Вот макрос добавления рисунков:
Это не помогло:
Программа формирует прайс лист и добавляет фото к позициям. Когда сохраняю в пдф проблем нет, но клиенты просят в эксель, но в итоге вместо рисунков видят "не удается отобразить связанный рисунок и т.д...". Вот макрос добавления рисунков:
| Код |
|---|
For i = 4 To Sheets("Price").Cells(Rows.Count, 1).End(xlUp).Row
Sheets("Price ").Range(Cells(i, 2).Address).Select
Dim x As Range
Set x = Selection 'Sheets("Price ").Range(Cells(Selection.Row, 3).Address)
Sheets("Price ").Range(Cells(i, 3).Address).Replace What:="""", Replacement:="", LookAt:=xlPart, SearchOrder:=xlByRows
imya = Sheets("Price ").Range(Cells(x.Row, 3).Address) 'имя позиции
If imya <> "" Then
On Error Resume Next
With Sheets("Price ").Pictures.Insert(путь_к_папке_с_рисунками\" & imya & ".jpg")
.ShapeRange.Height = 28 'ставим высоту рисунка
ширина = .ShapeRange.Width
.Name = imya
End With
If Err Then
With Sheets("Price ").Pictures.Insert(путь_к_папке_с_рисунками/рисунок_отсутствует .jpg")
.ShapeRange.Height = 28 'ставим высоту рисунка
ширина = .ShapeRange.Width
.Name = imya
End With
End If
Sheets("Price ").Shapes.Range(Array(имя)).IncrementTop 2 'ставим рисунок чуть ниже, чтобы было видно границу ячейки
Sheets("Price ").Shapes.Range(Array(имя)).IncrementLeft (x.Width - ширина) / 2 'определяем ширину столбца и ставим рисунок посередине
End If
Next i
|
Это не помогло:
| Код |
|---|
On Error Resume Next Set Pic = RangePhoto.Worksheet.Shapes.AddPicture(FlName, msoFalse) |
Изменено: - 18.08.2015 11:35:30
