Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Изменение изображения из ссылки в рисунок, изображения в таблице вставлены как ссылки, надо изменить на рисунки
 
#1
14.11.2015 22:05:15
Уважаемые специалисты, доброго времени суток!
Опишу вопрос по существу:
1.Выгружаю перечень остатков товаров из базы данных в эксель, список с артикулами и количеством и без изображений;
2.Копирую артикула и вставляю в другой файл эксель с макросами который подтягивает к артикулам изображения;
3.Копирую изображения и вставляю  обратно в исходный файл , получается напротив каждого артикула-изображение.
4.Скопированные изображения из файла с макросами (пункт2) являются изображениями ссылками(не знаю что это значит) имеют разные размеры и находятся в разных частях ячейки.
5.Приходится каждое изображение вырезать и вставлять правой кнопкой мыши как рисунок, в итоге все встают в левый верхний угол, затем все выделяю, задаю одинаковый размер и перетаскиваю в центр ячейки.
Вопрос: можно ли пункт номер 5 автоматизировать?

Вопросом интересовался, но ничего не нашел.Пример во вложении.Excel 2010
С уважением, Lari.
 
 
 
#2
14.11.2015 23:41:15
так чего сразу макросом не загружать изображения в нужный файл?
зачем двойная работа?
 
 
 
#3
15.11.2015 00:09:22
Lari, пробуйте
Код
Sub Lari()
Const PIC_WIDTH = 39.8 'ширина картинки
Const PIC_HEIGHT = 39.8 'высота картинки
Dim s As Shape, c As Range
For Each s In ActiveSheet.Shapes
  Set c = s.TopLeftCell
  s.LockAspectRatio = msoFalse
  s.Width = PIC_WIDTH
  s.Height = PIC_HEIGHT
  s.Left = c.Left + (c.Width - PIC_WIDTH) / 2
  s.Top = c.Top + (c.Height - PIC_HEIGHT) / 2
Next
End Sub
Это касается размеров и положения. Чтобы превратить изображения-ссылки во внедренные изображения, надо где-то дать команду "разорвать связи", в 2010 пока не нашел :(
Изменено: Казанский - 15.11.2015 00:10:19
 
 
 
#4
15.11.2015 06:32:25
можно всё сделать (скачать картинки по ссылкам, и вставить на лист) нажатием одной кнопки:
http://excelvba.ru/programmes/PastePictures
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#5
15.11.2015 11:09:23
Уважаемые эксперты, доброго времени суток!
Dima S, Вы правы, этот этап можно оптимизировать, но в приоритете пункт 5 моего вопроса.

Казанский, я испытал эстетическую эйфорию, когда одним нажатием запуска Вашего макроса все изображения выстроились и выровнялись.Очень круто, спасибо.

Игорь, спасибо за ссылку, в предлагаемой надстройке много функций и возможностей, но интересует лишь одна функция(поскольку с размерами вопрос решен) -замена имеющихся изображений ссылок на изображения рисунки.(аналог "разорвать связь"). Имеет значение мобильность макроса,я не могу спрогнозировать на скольких компьютерах он мне понадобится в рамках моей работы.(не занимаюсь коммерческой деятельностью).

С уважением, Lari.
Изменено: Lari - 15.11.2015 11:09:43
 
 
 
#6
15.11.2015 12:00:08
Макрос надо переделывать, чтобы изначально нормально картинку вставлял, а не связью.

Для Excel 2010 нужен другой способ вставки картинок, более сложный: не Pictures.Insert, а Shapes.AddPicture

Код
Sub ВставкаКартинкиВВыделенныйДиапазонЯчеек()
    PicLocation = Application.GetOpenFilename("Image Files (*.jpg),*.jpg", , "Select Image File", , False)
    If PicLocation = False Then Exit Sub        ' если отказ от выбора файла

    With ActiveSheet.Shapes.AddPicture(PicLocation, msoFalse, msoCTrue, 0, 0, 0, 0)
        .Top = Selection.Top
        .Left = Selection.Left
        .Width = Selection.Width
        .Height = Selection.Height
    End With
End Sub
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#7
15.11.2015 12:26:21
Игорь, я не могу вносить изменения в файл с макросами откуда берут картинки, поскольку это важный файл которым многие пользуются и который стабильно работает,  и если намудрю мне крышка.
Человек , который его создавал уже не работает , поэтому работаю только с имеющимся материалом, а имеются у меня на выходе картинки ссылки.

С уважением, Lari.
 
 
 
#8
17.11.2015 06:26:22
Игорь,доброго времени суток!

Я додумался скопировать макрос в другой файл и там с ним экспериментировать. Можно ли вставить вышеуказанный Вами макрос в макрос из данного файла?
Код
Private Sub CommandButton1_Click()
' Макрос3 Макрос
' Макрос записан 24.05.2007 (PL)
'
On Error Resume Next

Dim pics As Object
Set pics = ActiveSheet.Pictures
   
   
For Each asd In Selection
        
    Dim pis As Picture
    Dim pis2 As Picture
     
    If IsEmpty(asd.Value) Then
        Exit For
    End If
    Set pics2 = ActiveSheet.Pictures.ShapeRange(asd & " " & asd.Row & "-" & asd.Column)
    
    If Not IsObject(pic2) Then
    
    Set pic = pics.Insert(TextBox1.Value & "\" & asd.Value & ".jpg")
    
    
    If Not IsEmpty(pic) Then
        
    
    
    cell_aspect = asd.Height / pic.Height
    
    'pic.Width = pic.Width * cell_aspect
    pic.Height = pic.Height * cell_aspect
    
    cell_aspect = asd.Width / pic.Width
    
    If cell_aspect < 1 Then
    
        pic.Width = pic.Width * cell_aspect
        'pic.Height = pic.Height * cell_aspect
    
    End If
       
    pic.Left = (asd.Left + asd.Width / 2) - pic.Width / 2
    pic.Top = (asd.Top + asd.Height / 2) - pic.Height / 2
    pic.Placement = xlMoveAndSize
    pic.PrintObject = True
    pic.Name = asd & " " & asd.Row & "-" & asd.Column
    pic = Null
    End If
    End If
Next

End Sub
Изменено: Lari - 17.11.2015 18:06:49
 
 
 
Страницы: 1
Читают тему
Наверх