Здравствуйте! Вот _Boroda_ осчастливил юзеров макросом вставки картинки в файл
[vba]
Код
Sub tt() ' On Error Resume Next With Application.FileDialog(msoFileDialogOpen) .InitialFileName = "D:\прикол\" 'если картинки в той же папке, что и файл, то = ThisWorkbook.Path & "\" If .Show <> -1 Then Exit Sub ppp_ = .SelectedItems(1) End With Sheets("ДОГОВОР К-П").DrawingObjects.Delete 'Удаляет все объекты на листе Set kar_ = Sheets("ДОГОВОР К-П").Range("A1").Parent.Pictures.Insert(ppp_) With Sheets("ДОГОВОР К-П").Range("B238") kar_.Top = .Top kar_.Left = .Left End With End Sub
[/vba]
Вопрос в том, куда вставить этот макрос так, чтобы он был доступен из вновь открытого любого файла? После обновления/переустановки Эксела пропали макросы этот и второй - сохранить файл как pdf с тем же названием (именем файла)
Уточнение по макросу. Можно заменить "Sheets("ДОГОВОР К-П")" на ActiveSheet, чтобы картинка вставлялась на текущую активную страницу? Уточнение 2. Для вставки сразу двух картинок какую часть нужно продублировать?
прим. файл не прикладываю по причине его отсутствия, т.к. не знаю, куда прикрепить макрос.
Спасибо [moder]Код нужно оформлять специальным тегом. Кнопка # Поправил за Вас[/moder]
Здравствуйте! Вот _Boroda_ осчастливил юзеров макросом вставки картинки в файл
[vba]
Код
Sub tt() ' On Error Resume Next With Application.FileDialog(msoFileDialogOpen) .InitialFileName = "D:\прикол\" 'если картинки в той же папке, что и файл, то = ThisWorkbook.Path & "\" If .Show <> -1 Then Exit Sub ppp_ = .SelectedItems(1) End With Sheets("ДОГОВОР К-П").DrawingObjects.Delete 'Удаляет все объекты на листе Set kar_ = Sheets("ДОГОВОР К-П").Range("A1").Parent.Pictures.Insert(ppp_) With Sheets("ДОГОВОР К-П").Range("B238") kar_.Top = .Top kar_.Left = .Left End With End Sub
[/vba]
Вопрос в том, куда вставить этот макрос так, чтобы он был доступен из вновь открытого любого файла? После обновления/переустановки Эксела пропали макросы этот и второй - сохранить файл как pdf с тем же названием (именем файла)
Уточнение по макросу. Можно заменить "Sheets("ДОГОВОР К-П")" на ActiveSheet, чтобы картинка вставлялась на текущую активную страницу? Уточнение 2. Для вставки сразу двух картинок какую часть нужно продублировать?
прим. файл не прикладываю по причине его отсутствия, т.к. не знаю, куда прикрепить макрос.
Спасибо [moder]Код нужно оформлять специальным тегом. Кнопка # Поправил за Вас[/moder]карандаш
Сообщение отредактировал SLAVICK - Пятница, 22.01.2016, 10:08
я знаю как в Word'e вставить макрос - в Normal/ Тогда в любом файле он доступен. А в Экселе нет Normal'a Есть какая-то Personal.xlsb (это я увидел из ошибки исполнения макроса, который ругается, что не может её найти) Но где инструменты, чтобы исправить этот путь - я не знаю. Кнопка от макроса осталась и вывод ошибки исполнения при её нажатии. Всё остальное куда-то исчезло, да. ***. я сам поправил сразу. Не увидел сразу.
я знаю как в Word'e вставить макрос - в Normal/ Тогда в любом файле он доступен. А в Экселе нет Normal'a Есть какая-то Personal.xlsb (это я увидел из ошибки исполнения макроса, который ругается, что не может её найти) Но где инструменты, чтобы исправить этот путь - я не знаю. Кнопка от макроса осталась и вывод ошибки исполнения при её нажатии. Всё остальное куда-то исчезло, да. ***. я сам поправил сразу. Не увидел сразу.карандаш
Сообщение отредактировал карандаш - Пятница, 22.01.2016, 10:11
поправила код для вставки нескольких картинок: [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_() With Application.FileDialog(msoFileDialogOpen) .InitialFileName = "D:\прикол\" 'если картинки в той же папке, что и файл, то = ThisWorkbook.Path & "\" If .Show <> -1 Then Exit Sub For i = 0 To .SelectedItems.Count - 1 ReDim Preserve ppp_(0 To i) ppp_(i) = .SelectedItems(i + 1) Next i End With Debug.Print UBound(ppp_) ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) With ActiveSheet.Range("B" & 2 + i * 10) kar_.Top = .Top kar_.Left = .Left End With Next i End Sub
[/vba]
поправила код для вставки нескольких картинок: [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_() With Application.FileDialog(msoFileDialogOpen) .InitialFileName = "D:\прикол\" 'если картинки в той же папке, что и файл, то = ThisWorkbook.Path & "\" If .Show <> -1 Then Exit Sub For i = 0 To .SelectedItems.Count - 1 ReDim Preserve ppp_(0 To i) ppp_(i) = .SelectedItems(i + 1) Next i End With Debug.Print UBound(ppp_) ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) With ActiveSheet.Range("B" & 2 + i * 10) kar_.Top = .Top kar_.Left = .Left End With Next i End Sub
Марина, спасибо. Немного добавлю, чтобы картинки ровненько по вертикали располагались [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_() With Application.FileDialog(msoFileDialogOpen) .InitialFileName = ThisWorkbook.Path & "\" 'если картинки в другой папке, то путь к ней вида "D:\прикол\" If .Show <> -1 Then Exit Sub For i = 0 To .SelectedItems.Count - 1 ReDim Preserve ppp_(0 To i) ppp_(i) = .SelectedItems(i + 1) Next i End With ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) n_ = 20 'Расстояние между картинками по вертикали With ActiveSheet.Range("B2") kar_.Top = .Top + h_ kar_.Left = .Left h_ = kar_.Height + h_ + n_ End With Next i End Sub
[/vba]
Марина, спасибо. Немного добавлю, чтобы картинки ровненько по вертикали располагались [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_() With Application.FileDialog(msoFileDialogOpen) .InitialFileName = ThisWorkbook.Path & "\" 'если картинки в другой папке, то путь к ней вида "D:\прикол\" If .Show <> -1 Then Exit Sub For i = 0 To .SelectedItems.Count - 1 ReDim Preserve ppp_(0 To i) ppp_(i) = .SelectedItems(i + 1) Next i End With ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) n_ = 20 'Расстояние между картинками по вертикали With ActiveSheet.Range("B2") kar_.Top = .Top + h_ kar_.Left = .Left h_ = kar_.Height + h_ + n_ End With Next i End Sub
мда... Личная книга появляется только после первой записи любого макроса. Поэтому я её не видел. Вот получилося такой макрос (не надо выбирать картинки) [vba]
Код
Sub tt() ActiveSheet.Range("A1").Parent.Pictures.Insert ("c:\Users\kpa\Pictures\3.png") ActiveSheet.Range("A1").Parent.Pictures.Insert ("c:\Users\kpa\Pictures\1.png") End Sub
[/vba]
Скажите, тут всё верно? Он в принципе работает. И картинки вставляет в текущую, активную ячейку (они всегда разные для разных файлов).
А что нужно добавить для "относительного перемещения" по ячейкам, чтобы вторая картинка была рядом с первой? Например, две ячейки вправо и одна вниз. Попытка записать макрос даёт "абсолютный результат" - т.е. конкретную ячейку, а не смещение.
мда... Личная книга появляется только после первой записи любого макроса. Поэтому я её не видел. Вот получилося такой макрос (не надо выбирать картинки) [vba]
Код
Sub tt() ActiveSheet.Range("A1").Parent.Pictures.Insert ("c:\Users\kpa\Pictures\3.png") ActiveSheet.Range("A1").Parent.Pictures.Insert ("c:\Users\kpa\Pictures\1.png") End Sub
[/vba]
Скажите, тут всё верно? Он в принципе работает. И картинки вставляет в текущую, активную ячейку (они всегда разные для разных файлов).
А что нужно добавить для "относительного перемещения" по ячейкам, чтобы вторая картинка была рядом с первой? Например, две ячейки вправо и одна вниз. Попытка записать макрос даёт "абсолютный результат" - т.е. конкретную ячейку, а не смещение.карандаш
Я бы вот так написал, уж если Вы не хотите пользоваться смещением на высоту картинки, как я в предыдущем макросе сделал. [vba]
Код
Sub tt() Application.ScreenUpdating = 0 With ActiveSheet ad_ = Selection.Address .Range("C3").Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565.JPG") .Range("C3").Offset(1, 2).Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565_1.JPG") .Range(ad_).Select End With End Sub
Я бы вот так написал, уж если Вы не хотите пользоваться смещением на высоту картинки, как я в предыдущем макросе сделал. [vba]
Код
Sub tt() Application.ScreenUpdating = 0 With ActiveSheet ad_ = Selection.Address .Range("C3").Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565.JPG") .Range("C3").Offset(1, 2).Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565_1.JPG") .Range(ad_).Select End With End Sub
код в примере про "относительно смещение" вставляет значения в указанные конкретные ячейки
Мои две строки вставляют картинки относительно ячейки, которая активна. Попытка во второй строке изменить А1 на В3 ни к чему не привела.
Нужно не значения в ячейки вставить, а расположить картинки. Со смещением относительно произвольной ячеки (ткнул мышкой в нужное место, нажал кнопку макроса - картинки со смещением вставились). Не понял принципа действия вышеприведённого примера по отношению к картинкам и не смог его приспособить.
код в примере про "относительно смещение" вставляет значения в указанные конкретные ячейки
Мои две строки вставляют картинки относительно ячейки, которая активна. Попытка во второй строке изменить А1 на В3 ни к чему не привела.
Нужно не значения в ячейки вставить, а расположить картинки. Со смещением относительно произвольной ячеки (ткнул мышкой в нужное место, нажал кнопку макроса - картинки со смещением вставились). Не понял принципа действия вышеприведённого примера по отношению к картинкам и не смог его приспособить.карандаш
Sub tt() Selection.Parent.Pictures.Insert ("D:\Стереть\56565.JPG") Selection.Offset(1, 2).Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565_1.JPG") End Sub
Не понял принципа действия вышеприведённого примера
С пояснениями [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_(1) 'объявляем массив из 2-х элементов (начало с нуля) ppp_(0) = "D:\Стереть\56565.JPG" 'присваем значение первому элементу массива ppp_(1) = "D:\Стереть\56565_1.JPG" 'присваем значение второму элементу массива ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) 'цикл по элементам массива Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) 'вставляем i-ю картинку n_ = 20 'Расстояние между картинками по вертикали nn_ = 10 'Расстояние между картинками по горизонтали ' n_ и nn_ определяются пользователем методом научного тыка With Selection 'для левой верхней ячейки выделенного диапазона 'от левого верхнего угла выделеной ячейки отступаем h_ вниз или w_ вправо и передвигаем левый верхний угол 'только что вставленной картинки в полученную точку kar_.Top = .Top + h_ 'или + h_, или в строке ниже + w_ kar_.Left = .Left ' + w_ h_ = kar_.Height + h_ + n_ 'высота этой картинки + высота всех предыдущих + расстояние между картинками по высоте w_ = kar_.Width + w_ + nn_ 'ширина этой картинки + ширина всех предыдущих + расстояние между картинками по ширине End With Next i End Sub
Sub tt() Selection.Parent.Pictures.Insert ("D:\Стереть\56565.JPG") Selection.Offset(1, 2).Select Selection.Parent.Pictures.Insert ("D:\Стереть\56565_1.JPG") End Sub
Не понял принципа действия вышеприведённого примера
С пояснениями [vba]
Код
Sub tt() 'On Error Resume Next Dim ppp_(1) 'объявляем массив из 2-х элементов (начало с нуля) ppp_(0) = "D:\Стереть\56565.JPG" 'присваем значение первому элементу массива ppp_(1) = "D:\Стереть\56565_1.JPG" 'присваем значение второму элементу массива ActiveSheet.DrawingObjects.Delete 'Удаляет все объекты на листе For i = 0 To UBound(ppp_) 'цикл по элементам массива Set kar_ = ActiveSheet.Range("A1").Parent.Pictures.Insert(ppp_(i)) 'вставляем i-ю картинку n_ = 20 'Расстояние между картинками по вертикали nn_ = 10 'Расстояние между картинками по горизонтали ' n_ и nn_ определяются пользователем методом научного тыка With Selection 'для левой верхней ячейки выделенного диапазона 'от левого верхнего угла выделеной ячейки отступаем h_ вниз или w_ вправо и передвигаем левый верхний угол 'только что вставленной картинки в полученную точку kar_.Top = .Top + h_ 'или + h_, или в строке ниже + w_ kar_.Left = .Left ' + w_ h_ = kar_.Height + h_ + n_ 'высота этой картинки + высота всех предыдущих + расстояние между картинками по высоте w_ = kar_.Width + w_ + nn_ 'ширина этой картинки + ширина всех предыдущих + расстояние между картинками по ширине End With Next i End Sub
После открытия Эксела опять не было Личной книги. записал простой макрос, чтобы что-то было. Книга появилась. Стёр этот макрос и вставил туда новый макрос, который сработал на 5+. Но кнопка макроса в "Панели быстрого доступа" говорит "Не удаётся выполнить макрос "PERSONAL.XLSB!tt". Возможно этот макрос отсутствует в текущей книге либо все макросы отключены" Попытка запустить макрос из списка макросов (через панель разработчика) пишет "Compile error: Wrong number of argument or invalid property assigment"
Личную Книгу сохранил через кнопку с дискетой в VBA "Сохранить"
Кнопки пытался переназначить на существующий макрос - не помогло.
что бы это значило? где я что-то не так сделал?
прошу пардону! всё рухнуло (((
не запускается макросы из "личной книги"
После открытия Эксела опять не было Личной книги. записал простой макрос, чтобы что-то было. Книга появилась. Стёр этот макрос и вставил туда новый макрос, который сработал на 5+. Но кнопка макроса в "Панели быстрого доступа" говорит "Не удаётся выполнить макрос "PERSONAL.XLSB!tt". Возможно этот макрос отсутствует в текущей книге либо все макросы отключены" Попытка запустить макрос из списка макросов (через панель разработчика) пишет "Compile error: Wrong number of argument or invalid property assigment"
Личную Книгу сохранил через кнопку с дискетой в VBA "Сохранить"
Кнопки пытался переназначить на существующий макрос - не помогло.
что бы это значило? где я что-то не так сделал?карандаш
Добрый день. Уважаемые специалисты, прошу помогите. Есть макрос по вставке изображений в Excel, но он создает ссылку на картинку, при отправке по почте или открытии на другом компьютере картинки не отображаются. Если кто то может доработать файл, помогите, необходимо, что-бы вставленное изображение видно было на другом компьютере. К сообщению прикрепил вложение " макрос работает по нажатию кнопки". Поглядите, что можно сделать...
------------ Sub КНОПКА() Dim datei As String datei = Excel.Application.GetOpenFilename(" Bilddateien (*.), *.", True) Range("A3").Select Selection.Delete ActiveSheet.Pictures.Insert(datei).Select Selection.ShapeRange.Width = 480 'Defines the variable as a variant data type Dim X As Variant 'Continues to run the macro even if an error occurs On Error Resume Next 'Loops through every file that is selected and opens each one For Y = 1 To UBound(X) Workbooks.Open X(Y) Next Exit Sub End Sub [moder]Читаем Правила форума, создаём свою тему. Эта тема закрыта. И код следует оформлять тегами (кнопка #)[/moder]
Добрый день. Уважаемые специалисты, прошу помогите. Есть макрос по вставке изображений в Excel, но он создает ссылку на картинку, при отправке по почте или открытии на другом компьютере картинки не отображаются. Если кто то может доработать файл, помогите, необходимо, что-бы вставленное изображение видно было на другом компьютере. К сообщению прикрепил вложение " макрос работает по нажатию кнопки". Поглядите, что можно сделать...
------------ Sub КНОПКА() Dim datei As String datei = Excel.Application.GetOpenFilename(" Bilddateien (*.), *.", True) Range("A3").Select Selection.Delete ActiveSheet.Pictures.Insert(datei).Select Selection.ShapeRange.Width = 480 'Defines the variable as a variant data type Dim X As Variant 'Continues to run the macro even if an error occurs On Error Resume Next 'Loops through every file that is selected and opens each one For Y = 1 To UBound(X) Workbooks.Open X(Y) Next Exit Sub End Sub [moder]Читаем Правила форума, создаём свою тему. Эта тема закрыта. И код следует оформлять тегами (кнопка #)[/moder]Serega_SS