Вставить изображение в ячейку Excel

@demon-joker · Регистрация: 30.03.2012

Студворк — интернет-сервис помощи студентам

Привет всем Гуру ЕКСЕЛЯ И VBA.
Помогите разобратся с проблемкой!
Как сделать в екселе 2007 чтоб при щелчке на ячейке А3 отрывалось собственное окно черес которое, можно вставить самому фото в ячейку А3 и чтоб фотка подганялась под разьмеры етой ячейки (Нужная высота строки 185, а ширина строки 46 - может ето Вам надо знать). Извините што прошу Вас об етом, но в VBA я полний ноль.

@Казанский · 04.04.2012, 23:29

В модуль листа (правый клик по ярлычку листа - Исходный текст):

Visual Basic
1
2
3
4
5
6
7
8
9
10
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = "$A$3" Then
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        With Selection
            .Width = Target.Width
            .Height = Target.Height
        End With
    End If
End If
End Sub

Делал в Excel 2000, в 2007 может быть немного по-другому.

@demon-joker · 05.04.2012, 10:51 **[ТС]**

Спасибо Казанский за быстрый ответ - ты молодец, но в екселе 2007
ета часть

Visual Basic
1
2
    .Width = Target.Width
    .Height = Target.Height

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

@Alex77755 · 05.04.2012, 11:59

Visual Basic
1
LockAspectRatio := msoFalse;

Как изменить размер картинки и вписать ее в размер определенной области ячеек?

Если пытаться изменять размер картинки, то она, по умолчанию, будет менять размер пропорционально. Такую особенность задает свойство LockAspectRatio объекта Shape. Если установить LockAspectRatio равным msoFalse, то картинка будет менять размеры непропорционально.

C#
1
2
3
4
5
// Картинка будет вписана в область D12:J18 с сохранением пропорций
    AShape.Width := ASheet.Range['K12', EmptyParam].Left -
      ASheet.Range['D12', EmptyParam].Left;
    AShape.Height := ASheet.Range['D19', EmptyParam].Top -
      ASheet.Range['D12', EmptyParam].Top;

C#
1
2
3
4
5
6
// Картинка будет вписана во всю область D12:J18 без сохранения пропорций
    AShape.LockAspectRatio := msoFalse;
    AShape.Width := ASheet.Range['K12', EmptyParam].Left -
      ASheet.Range['D12', EmptyParam].Left;
    AShape.Height := ASheet.Range['D19', EmptyParam].Top -
      ASheet.Range['D12', EmptyParam].Top;

Добавлено через 8 минут

Visual Basic
1
2
3
4
5
        With Selection
           .ShapeRange.LockAspectRatio = msoFalse
           .Width = Target.Width
           .Height = Target.Height
        End With

@demon-joker · 05.04.2012, 20:48 **[ТС]**

Alex77755 - ты the BEST!!!! Спасибо!
Ребята, если етот макрос работает для одной ячейки - то в принцепе его можно применить к діапазону (яч.A3, яч.B3, яч.C3, яч.D3).
Почему он не работает?

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
If Target.Address = ("$A$3","$B$3","$C$3","$D$3")  Then '///////////////
    If Application.Dialogs(xlDialogInsertPicture).Show Then
        With Selection
        .ShapeRange.LockAspectRatio = msoFalse
            .Width = Target.Width
            .Height = Target.Height
        End With
    End If
End If
End Sub

Я што что то делаю не правильно, а по другому не умею.

@Казанский · 05.04.2012, 21:09

Visual Basic
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

@demon-joker · 05.04.2012, 21:32 **[ТС]**

Ребята, спасибо!!!!!!

Вы ГЕНИИ VBA?
Как Вы научились, посоветуйте с чего начать. Я тож хочу такие штуки писать.
ОГРОМНАЯ БЛАГОДАРНОСТЬ ВСЕМ КТО ОТКЛИКНУЛСЯ НА МОЮ ПРОСЬБУ!!!!!

@strike383 · 24.07.2013, 06:00

Нужна помощь по этой же теме

Сообщение от Казанский

Visual Basic
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

как изменить этот код, чтоб окно выбора картинки появлялось при нажатии не на конкретную ячейку A3, B3, C3, D3, а на любую ячейку всего столбца, к примеру "В", и чтоб картинка подгонялась под размер ячейки, при этом сохраняя свои пропорции.
Еще было бы очень хорошо, еслиб работал макрос в объединенных ячейках всего столбца

Пример:

@SlavaRus · 24.07.2013, 09:23

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("B:B"), Target) Is Nothing Then
        If Application.Dialogs(xlDialogInsertPicture).Show Then
            With Selection
                .ShapeRange.LockAspectRatio = msoTrue
                .Height = Target.Height
                If .Width > Target.Width Then
                    .Width = Target.Width
                End If
            End With
        End If
    End If
End Sub

@strike383 · 24.07.2013, 11:05

Сообщение от SlavaRus

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Not Intersect(Range("B:B"), Target) Is Nothing Then
        If Application.Dialogs(xlDialogInsertPicture).Show Then
            With Selection
                .ShapeRange.LockAspectRatio = msoTrue
                .Height = Target.Height
                If .Width > Target.Width Then
                    .Width = Target.Width
                End If
            End With
        End If
    End If
End Sub

Спасибо большое дружище, работает!!!!

@phpk · 12.09.2013, 22:16

Если вставить рисунок в Excel и выйти из документа и потом повторно войти в Excel, вышеприведённый код не работает. Надо заново входить в "Исходный текст" для ввода кода.
А как сделать чтобы повторно не надо было вводить код?

Добавлено через 36 минут
ясно.
Надо сначало Excel сохранить в формате с использованием макросов

Добавлено через 14 минут
а как сохранять качество рисунка, т.е. пропорции?
Может это не по теме, но просто не у кого больше спросить сейчас.
Подскажите пожалуйста.
После повторного открытия Excela и растягивания картинки качество сильно размытое

Новые блоги и статьи Все статьи Все блоги /
Мысли в слух. Про "навсегда". kumehtar 16.04.2026 Подумалось тут, что наверное очень глупо использовать во всяких своих установках понятие "навсегда". Это очень сильное понятие, и я только начинаю понимать край его смысла, не смотря на то что давно. . .	My Business CRM MaGz GoLd 16.04.2026 Всем привет, недавно возникла потребность создать CRM, для личных нужд. Собственно программа предоставляет из себя базу данных клиентов, в которой можно фиксировать звонки, стадии сделки, а также. . .	Знаешь почему 90% людей редко бывают счастливыми? kumehtar 14.04.2026 Потому что они ждут. Ждут выходных, ждут отпуска, ждут удачного момента. . . а удачный момент так и не приходит.	Фиксация колонок в отчете СКД Maks 14.04.2026 Фиксация колонок в СКД отчета типа Таблица. Задача: зафиксировать три левых колонки в отчете. Процедура ПриКомпоновкеРезультата(ДокументРезультат, ДанныеРасшифровки, СтандартнаяОбработка) / / . . .
Настройки VS Code Loafer 13.04.2026 { "cmake. configureOnOpen": false, "diffEditor. ignoreTrimWhitespace": true, "editor. guides. bracketPairs": "active", "extensions. ignoreRecommendations": true, . . .	Оптимизация кода на разграничение прав доступа к элементам формы Maks 13.04.2026 Алгоритм из решения ниже реализован на нетиповом документе, разработанного в конфигурации КА2. Задачи, как таковой, поставлено не было, проделанное ниже исключительно моя инициатива. Было так:. . .	Контроль заполнения и очистка дат в зависимости от значения перечислений Maks 12.04.2026 Алгоритм из решения ниже реализован на примере нетипового документа "ПланированиеПерсонала", разработанного в конфигурации КА2. Задача: реализовать контроль корректности заполнения дат назначения. . .	Архитектура слоя интернета для сервера-слоя. Hrethgir 11.04.2026 В продолжение https:/ / www. cyberforum. ru/ blogs/ 223907/ 10860. html Знаешь что я подумал? Раз мы все источники пишем в голове ветки, то ничего не мешает добавить в голову такой источник, который сам. . .

@demon-joker 0 / 0 / 0 Регистрация: 30.03.2012 Сообщений: 11

	Вставить изображение в ячейку Excel 04.04.2012, 23:16. Показов 32975. Ответов 10 Метки нет (Все метки) Привет всем Гуру ЕКСЕЛЯ И VBA. Помогите разобратся с проблемкой! Как сделать в екселе 2007 чтоб при щелчке на ячейке А3 отрывалось собственное окно черес которое, можно вставить самому фото в ячейку А3 и чтоб фотка подганялась под разьмеры етой ячейки (Нужная высота строки 185, а ширина строки 46 - может ето Вам надо знать). Извините што прошу Вас об етом, но в VBA я полний ноль. 0

@demon-joker 0 / 0 / 0 Регистрация: 30.03.2012 Сообщений: 11
	05.04.2012, 21:32 [ТС]
	Ребята, спасибо!!!!!! Вы ГЕНИИ VBA? Как Вы научились, посоветуйте с чего начать. Я тож хочу такие штуки писать. ОГРОМНАЯ БЛАГОДАРНОСТЬ ВСЕМ КТО ОТКЛИКНУЛСЯ НА МОЮ ПРОСЬБУ!!!!! 0

@phpk 27 / 41 / 13 Регистрация: 15.05.2013 Сообщений: 1,313
	12.09.2013, 22:16
	Если вставить рисунок в Excel и выйти из документа и потом повторно войти в Excel, вышеприведённый код не работает. Надо заново входить в "Исходный текст" для ввода кода. А как сделать чтобы повторно не надо было вводить код? Добавлено через 36 минут ясно. Надо сначало Excel сохранить в формате с использованием макросов Добавлено через 14 минут а как сохранять качество рисунка, т.е. пропорции? Может это не по теме, но просто не у кого больше спросить сейчас. Подскажите пожалуйста. После повторного открытия Excela и растягивания картинки качество сильно размытое 0

Вставить изображение в ячейку Excel

Решение