Всем доброе утро. Коллеги, столкнулся со срочной ситуацией и не могу найти самостоятельно ответ на свой вопрос, прошу помощи в доработке макроса.
Есть файл, суть принципа такова: На листе Затраты в столбик H вручную проставляются номера примечаний 1, 2, 3, 4, 5..... Документ лежит в одной папке с картинками формата jpg, которые подписываются также - 1, 2, 3, 4....
После нажатия на кнопку Загрузка скан-копий происходит создание листов согласно проставленных номерков в столбике H и на эти листы вставляются одноименные картинки... Всё вроде отлично работало, но есть две проблемы:
1. Картинки вставляются не как объекты, а как ссылки и при удалении картинки с папки или пересылки документа в другое место понятное дело получаем "Изображение не найдено"..., хотелось бы чтоб картинки вставлялись именно как отдельный независимый объект и тут же одно небольшое примечание, у меня в коде прописана поиск и вставка из папки картинок jpg, можете подправить так что искало и вставляло графические объекты из текущей папки независимо от формата.
2. А вторая проблема в том, что при большом количестве примечаний(картинок) около 20-ти не создаются все листы, почему-то пропускает создание части листов...
Прошу тех кто гуру в макросах, помочь оптимизировать данный макрос.
Dim sha As Shape
Set sha = ActiveSheet.Shapes.AddPicture(ПутьКФайлу$, msoFalse, msoCTrue, -1, -1, -1, -1)
А применённый вами метод
Цитата
Pictures.Insert
хоть и взят из макроса, написанного мной, имеет некоторые ограничения (не все форматы файлов вставляет, картинки не сохраняются с файлом в Excel 2010, и т.д.)
По второму вопросу - подсказать не могу, т.к. протестировать ваш макрос без нужных картинок проблематично.
PS: А если кому понадобится универсальная надстройка для вставки картинок в Excel — вы можете скачать её здесь: http://excelvba.ru/programmes/PastePictures Надстройка умеет не только вставлять картинки в ячейки и примечания, но и искать недостающие картинки в Google
EducatedFool пишет: Dim sha As Shape Set sha = ActiveSheet.Shapes.AddPicture(ПутьКФайлу$, msoFalse, msoCTrue, -1, -1, -1, -1)
Да, это оно, теперь картинки именно влаживаются в файл. Только подскажите где тут указать чтоб влаживалось в ячейку b1, а не в а1. и тогда первый пункт моей проблемы полностью будет решен))))
Насчет вашей надстройки, я давно её видел и пробовал тестировать, у меня немножко другая цель преследуется и надстройка немного для меня не актуальна, а так считаю весьма полезная штука
Цитата
т.к. протестировать ваш макрос без нужных картинок проблематично.
тут все просто, любых 20 картинок формата jpeg, можно даже одну и ту же скопировать 20 раз и переименовать порядковыми номерами, а потому в столбец H проставить эти номер в разброс чтоб они не подряд шли.
я пока писал то что разобрался с этим, вы дали ответ быстрее)))) правда я сделал по другому, я вместо первого значения "-1" поставил значение 50 и картинка начала попадать в b1 я вот пытаюсь добиться чтоб понимало не только .jpg но и любые другие форматы картинки, нужно что то сделать с этой строкой:
Код
primer = ThisWorkbook.Path & "\" & nmr & ".jpg"
а вот что?
как указать последний аргумент не jpg, а "любой графический файл"?
и по прежнему ищу причину, почему не создаются все необходимые листы.
как указать "любой графический объект" я не понял пока что, а вот с той проблемой, что не создаются все листы на которые есть картинки, увидел закономерность... если в столбик H проставить номерки... даже хотя бы 3 подряд в соседних ячейках: H4 = 1 H5 = 2 H6 = 3
то листы создаются только 1 и 3, а 2 пропускает и не создает его, если значения подряд будет еще больше, то все равно лист будет создан только для первого и последнего значения которые идут подряд, если же номера проставлять хотя бы через строку, то все работает.
проблема где то тут скорее всего:
Код
lr = Cells(Rows.Count, 1).End(xlUp).Row
lb = sh.[h2].End(xlDown).Row
Do
fr = sh.Cells(lb, 8).End(xlDown).Row - 1
If fr > lr Then fr = lr
nmr = sh.Cells(lb, 8).Value
Worksheets("ш").Visible = -1
Sheets("ш").Select
Sheets("ш").Copy After:=Sheets(Sheets.Count)
ActiveSheet.Name = nmr