Страницы: 1
RSS
Вписать картинку в ячейку определенного размера.
 
Есть очень много картинок в соцсети.
Необходимо вписать все эти картинки в одинаковые ячейки (см. вложения)
Если просто нажать копировать картинку, а потом в файле нажимать вставить, то картинка вставляется большая (см. вложения)
Растягивать, сужать каждую вручную очень долго.
Подскажите способ делать это быстро и чтобы картинка сразу принимала нужный размер по ячейкам.

Темы похожие находил, но мои познания не позволяют воспринимать эту информацию :(
Вот нашел такое, но не знаю как применять и подходит ли мне это :(
Помогите :)
Код
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Target, Range("A1:A10000")) Is Nothing Then
        If ActiveSheet.Paste Then
            On Error GoTo 10
            With Selection
                .ShapeRange.LockAspectRatio = msoFalse
                .Width = Target.Width
                .Height = Target.Height
            End With
        End If
    End If
10: End Sub

Скрытый текст
 
А как Вы копируете и вставляете? Сочетанием клавиш (Ctrl+C, Ctrl+V) или мышью или еще как?
 
Сочетанием клавиш.
 
Цитата
kotonyan89 написал: подходит ли мне это
не подходит, этот макрос уменьшает размеры а не фотку (вес тот же будет)
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
Понадобится три макроса. Скопируйте и вставьте эти три макроса в один модуль:
макросы

Перед началом работы (перед вставкой и копированием картинок) запустите макрос "НазначитьКлавиши", затем начинайте копировать и вставлять картинки. Когда закончите, запустите макрос "СброситьКлавиши", чтобы сочетание "Ctrl+V" снова стало делать то, что и раньше.

P.S. Сочетание Ctrl+V станет прежним и без использования макроса "СброситьКлавиши", если закрыть Excel.
Изменено: Karataev - 18.04.2016 21:03:08
 
в этот код бы я бы вишенку добавил
Код
1
    shp.Placement = xlMoveAndSize
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
Можете готовое решение попробовать
http://excelvba.ru/programmes/PastePictures

И картинку найдет (в папке, или в интернете), и вставит как надо в ячейку
 
Игорь, Ваш код уменьшает вес картинки ?   понял глупость вопроса
Изменено: Фродо - 18.04.2016 21:53:27
у меня простая версия Экселя, в ней нет кнопки "Прочитать мысли и сгенерировать файл пример"
 
Karataev,большое спасибо за помощь. все четко и понятно ;)
 
и всем кто откликнулись тоже спасибо 8)
 
Можете еще вот так попробовать (по совету Фродо (пост #6)):
Код
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
Sub Вставить()
      
    Dim shp As Shape
      
    Application.ScreenUpdating = False
      
    ActiveSheet.Paste
    Set shp = ActiveSheet.Shapes(ActiveSheet.Shapes.Count)
      
    'чтобы не сохранялись пропорции
    shp.LockAspectRatio = False
    shp.Height = ActiveCell.Height
    shp.Width = ActiveCell.Width
    'чтобы размеры картинки изменялись при изменении размеров ячеек
    shp.Placement = xlMoveAndSize
 
    Application.ScreenUpdating = True
      
End Sub

Это работает так: когда Вы будете изменять высоту строки или ширину столбцов, то размеры картинки тоже будут изменяться.
Страницы: 1
Читают тему
Наверх
Loading...