Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Вставка картинки нужного размера
 
#1
22.02.2013 14:05:52
Всем добрый день.
Перекопал форум - ответа не нашел.

Есть масса картинок разного размера, которые необходимо вставить в лист. Можно ли сделать так, чтобы при вставке картинка сразу принимала размер ячейки, куда ее вставляют?
Очень парит 600 картинок руками "вписывать"

Спасибо.
 
 
 
#2
22.02.2013 14:22:54
можно танцевать от этого
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
Dim p As Object
Dim s As String
  Jak = 1 ' если Jak = 1, то картинка сжимается до размера ячейки
   ' если Jak = 2, то ячейка увеличивается до размера картинки
      s = "полный путь к файлу\имя_файла.jpg"
      If Dir(s) <> "" Then
        Set p = ActiveSheet.Pictures.Insert(s)
        p.Placement = xlMoveAndSize
        p.PrintObject = True
        p.Top = Cells(1, 1).Top
        p.Left = Cells(1, 1).Left
        If Jak = 1 Then
          With Cells(1, 1)
            p.ShapeRange.LockAspectRatio = msoTrue
            p.Width = .Offset(0, 1).Left - .Left
            p.Height = .Offset(1, 0).Top - .Top
          End With
        End If
        If Jak = 2 Then
          p.Placement = xlFreeFloating
          Columns(1).ColumnWidth = p.Width
          Rows(1).RowHeight = p.Height
        End If
        Set p = Nothing
      End If
Учимся сами и помогаем другим...
 
 
 
#3
22.02.2013 14:25:37
Цитата
Алексей Котельников пишет: ... Перекопал форум - ответа не нашел...
Наверное, не той лопатой... ;)
- http://www.planetaexcel.ru/techniques/1/39/
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#4
22.02.2013 15:28:14
Цитата
Наверное, не той лопатой...
Неее, там немного не то. Видел. Там привязка, а вопрос - когда я выбираю ячейку и нажимаю ctrl+v - фото вставляется уже в размер ячейки и ее (фотографию) не надо править руками (читай подгонять края под размер ячейки).

Код не пробовал еще, отпишусь.
Спасибо.
 
 
 
#5
22.02.2013 15:34:05
С кодом что-то не срослось ((((

Еще, как я понимаю, это не совсем макрос что ли... Это типа реакции на команду вставить и если в буфере картинка, тогда ее надо вставить в ячейку, а стороны установить равными размерам сторон ячейки.

Опять же, это как мне кажется, а так как я профан в этих делах - простите если "сморозил".
 
 
 
#6
22.02.2013 15:35:28
это содержимое процедуры. вставьте ее как реакция на кнопку. да и путь укажите настоящий
Учимся сами и помогаем другим...
 
 
 
#7
22.02.2013 15:39:21
Цитата
ber$erk пишет: да и путь укажите настоящий
Пути как такового нет. Рисунок копируется из 1С руками. Т.е по факту я открываю 1С, открываю окно номенклатуры с рисунком, кликаю на рисунок - ctrl+c. Переключаюсь в лист Excel, выбираю ячейку куда вставить надо ctrl+v. Потом руками подгоняю края (что больше всего и раздражает, так как мне надо 600 таких скопировать).
 
 
 
#8
22.02.2013 15:53:15
почитайте - не подойдет?
http://www.forum.mista.ru/topic.php?id=374470
Учимся сами и помогаем другим...
 
 
 
#9
22.02.2013 15:59:12
Тоже не совсем то. Точнее совсем не тот.

Спасибо за попытки помочь, но увы...
Буду так пока мучаться )))) Полезно иногда и рутинной работой позаниматься.
 
 
 
#10
22.02.2013 16:03:28
Цитата
Алексей Котельников пишет: мне надо 600 таких скопировать
1 - зачем (!!!) столько ЭТОГО в XL?!.
2 - ищем приблуды вроде "Достать картинки из файла"... ;)
"Ctrl+S" - достойное завершение ваших гениальных мыслей!.. ;)
 
 
 
#11
22.02.2013 16:37:44
Уважаемые мои...
Ну вот такая идиотская задача. Достать из файла - не катит - файла тоже нет. Есть окно 1С и там внутри картинка.
Нашел вот такой код:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(0, 0)
Case "A3", "B3", "C3", "D3"
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = Target.Width
            .Height = Target.Height
        End With
    End If
End Select
End Sub

Делает то, что надо, но.... ))) При клике он спрашивает откуда достать рисунок, а мне его реакция нужна по всему столбцу А, так еще и не с запросом откуда взять рисунок, а тупо - ему вставили, а он размер подогнал ))))
 
 
 
#12
22.02.2013 18:30:49
А почему бы не использовать готовое решение для вставки картинок в Excel?
http://excelvba.ru/programmes/PastePictures

Там есть много опций (настроек) + дополнительные возможности.
Надстройки для Excel  Парсинг сайтов  Мониторинг цен конкурентов
 
 
 
#13
22.02.2013 23:05:46
Алексей Котельников, Посмотрите. В этом направлении можно поискать.
Изменено: Sergei_A - 23.02.2013 00:22:38 (Забыл прикрепить файл, ..... сорри)
 
 
 
#14
23.02.2013 12:18:47
Получилось вот так вот - что меня вполне устраивает. Подскажите плиз, как задать диапазон по столбцу А всему. Руками прописывать все ячейки - ну вообще никак )))
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Select Case Target.Address(0, 0)
Case "A1", "A2", "A3", "A4"
    If ActiveSheet.Paste Then
      On Error GoTo 10
             With Selection
            .ShapeRange.LockAspectRatio = msoFalse
            .Width = Target.Width
            .Height = Target.Height
        End With
    End If
    End Select
10: End Sub
 
 
 
#15
23.02.2013 12:33:52
Попробуйте так (не проверял)
Код
?
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
 
 
 
#16
23.02.2013 13:17:39
Юрий М, спасибо, подходит.
 
 
 
#17
29.08.2023 08:46:18
Цитата
написал:
Код ? 123456789101112
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
Уважаемые гуру VBA, подскажите как данный код заставить работать от кнопки и что бы картинка вставлялась в выделенный мышкой диапазон, метод научного тыка не сработал, а изучение VBA на очень начальном уровне.
Изменено: BAD_BOY - 29.08.2023 08:47:59
 
 
 
#18
29.08.2023 10:31:44
пробуйте:
Код
?
1
2
3
4
5
6
7
8
9
10
11
12
Sub InsPicture()
  Dim w, h
  With Selection
    w = .Width: h = .Height
  End With
  If ActiveSheet.Paste Then
    With Selection
      .ShapeRange.LockAspectRatio = msoFalse
      .Width = w: .Height = h
    End With
  End If
End Sub
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#19
29.08.2023 14:05:03
Цитата
написал:
пробуйте:
Огромное Спасибо!!!
 
 
 
#20
01.09.2023 09:00:48
1
2
3
4
5
6
7
8
9
10
11
12		Sub InsPicture()
 Dim w, h
 With Selection
   w = .Width: h = .Height
 End With
 If ActiveSheet.Paste Then
   With Selection
     .ShapeRange.LockAspectRatio = msoFalse
     .Width = w: .Height = h
   End With
 End If
End Sub
Уважаемые форумчане, подскажите вдруг кто сталкивался с такой аномалией.
Сперва этот код работал отлично, но потом начал привязывать картинку к левому верхнему углу ячейки A1 хоть и по размерам выделенной области, в чём может быть загвоздка?
p.s. проверял на совершенно пустом файле вновь созданном, Лист Microsoft Excel (1).xlsm вставляет, с нужными размерами, но не в выделенную область.
 
 
 
#21
01.09.2023 09:12:58
приложите файл, расскажите куда собирались вставить картинку, может что-то выяснится, а так - вроде все работает, а гадать не интересно
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#22
01.09.2023 13:03:00
Копирую часть картинки из программы Paint, выделяю нужные ячейки, нажимаю в екселе кнопку на этот макрос и картинка принимает размер выделенной области, но при этом позиционируется в верхний левый угол ячейки A1, но если эту картинку уже вставленную скопировать снова, уже из екселя, то дальше она вставляется как нужно, в любую ячейку и их количество.
p.s. Файл не прикладываю он полностью пустой только макрос и стандартного размера ячейки.
 
 
 
#23
06.09.2023 07:50:00
Цитата
написал:
приложите файл
 
 
 
#24
07.09.2023 09:14:37
Пробовал дома с paint результат тот же, а вот с фотошопом работает как нужно.
Но с другим редактором кроме paint работать нет возможности.
 
 
 
Страницы: 1
Читают тему
Наверх
Loading...