Вставка картинки согласно параметрам ячейки

Дата: Понедельник, 20.04.2020, 19:28 | Сообщение № 1

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

Друзья, добрый вечер.

Я плохо разбираюсь в VBA, но нужно сделать макрос вставки картинки в ячейку.

1 Вопрос. При отмене вставки выпадает ошибка, как ее убрать.
2 Вопрос. Как прописать Width:= xxx Height:= xxx согласно размерам ячейки.

Файл прилагаю

Заранее спасибо

К сообщению приложен файл: 0381247.xlsm (20.1 Kb)

Дата: Понедельник, 20.04.2020, 20:02 | Сообщение № 2

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Так нужно?

[vba]

Код

Sub InsertPicUsingShapeAddPictureFunction()
    Dim profile     As String
    On Error Resume Next
    Dim fd          As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    With ActiveSheet.Range("D2")
        ActiveSheet.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoCTrue, _
            Left:=.Left + 2, _
            Top:=.Top + 2, _
            Width:=.Width, _
            Height:=.Height
    End With
End Sub

[/vba]

Скажи мне, кудесник, любимец ба’гов...
Платная помощь:
Boroda_Excel@mail.ru
Яндекс-деньги: 41001632713405 | Webmoney: R289877159277; Z102172301748; E177867141995

Дата: Понедельник, 20.04.2020, 20:11 | Сообщение № 3

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

_Boroda_, да. Спасибо Вам большое

Дата: Понедельник, 20.04.2020, 20:22 | Сообщение № 4

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Только обратите внимание, что если несколько раз вставлять картинки, то предыдущая не удаляется и в итоге получится, что у Вас в ячейке будет куча картинок, наложенных друг на дружку
Вот так попробуйте
[vba]

Код

Sub InsertPicUsingShapeAddPictureFunction()
    Dim profile     As String
    On Error Resume Next
    Dim fd          As FileDialog
    Set fd = Application.FileDialog(msoFileDialogFilePicker)
    With fd
        .Filters.Clear
        .Filters.Add "Picture Files", "*.bmp;*.jpg;*.gif;*.png"
        .ButtonName = "Select"
        .AllowMultiSelect = False
        .Title = "Choose Photo"
        .InitialView = msoFileDialogViewDetails
        .Show
    End With
    With ActiveSheet.Range("D2")
        For Each as_ In ActiveSheet.Shapes
            If as_.Left = .Left + 2 Then
                as_.Delete
                Exit For
            End If
        Next as_
        ActiveSheet.Shapes.AddPicture Filename:=fd.SelectedItems(1), _
            LinkToFile:=msoFalse, _
            SaveWithDocument:=msoCTrue, _
            Left:=.Left + 2, _
            Top:=.Top + 2, _
            Width:=.Width, _
            Height:=.Height
    End With
End Sub

[/vba]

Дата: Понедельник, 20.04.2020, 21:38 | Сообщение № 5

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

_Boroda_, это вообще шикарно!

Спасибо большое за крутой лайф хак

Дата: Вторник, 21.04.2020, 16:36 | Сообщение № 6

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

_Boroda_, Подскажите пожалуйста, если надо вставить фото в Ячеку D2 и в ячеку E2, F2, G2. Что бы выбирал ячейку и потом нажимал вставить фото и фотка вставлялась в выбранную ячейку. Как это реализовать ?

К сообщению приложен файл: primer.xlsm (21.1 Kb)

Сообщение отредактировал Gopronotmore - Вторник, 21.04.2020, 16:38

Дата: Вторник, 21.04.2020, 16:53 | Сообщение № 7

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Так нужно?

К сообщению приложен файл: primer_1.xlsm (355.4 Kb)

Дата: Вторник, 21.04.2020, 19:07 | Сообщение № 8

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

_Boroda_, да спасибо болошьшое. А у меня вопрос. Мы прописываем строгий диапазон ячеек. А можно как-то от него отойти ? Или всегда нужно будет его прописывать ?

Дата: Вторник, 21.04.2020, 19:15 | Сообщение № 9

Группа: Админы

Ранг: Местный житель

Сообщений: 16711

Репутация: 6502 ±

Замечаний: ±

2003; 2007; 2010; 2013 RUS

Слушайте, Вы сами написали

Цитата Gopronotmore, 21.04.2020 в 16:36, в сообщении № 6 ()

надо вставить фото в Ячеку D2 и в ячеку E2, F2, G2

А теперь отойти нужно

Держите. Кстати, теперь можно выделять несколько ячеек, вставлять картинку будет в левую верхнюю
И да, в предыдущем файле (если будете им пользоваться) раскомментируйте строку
[vba]

Код

On Error Resume Next

[/vba]

К сообщению приложен файл: primer_2.xlsm (83.4 Kb)

Дата: Вторник, 21.04.2020, 19:33 | Сообщение № 10

Группа: Проверенные

Ранг: Форумчанин

Сообщений: 236

Репутация: 3 ±

Замечаний: 0% ±

Excel 2007

_Boroda_, спасибо большое. Просто я думал, запросив в выбранную ячейку, смогу исправить код, что бы в каждую вмещалась картинка. Но нет не получилось! Спасибо большое!