Страницы: 1
RSS
Доработка макроса вставки картинок
 
Всем доброе утро. Коллеги, столкнулся со срочной ситуацией и не могу найти самостоятельно ответ на свой вопрос, прошу помощи в доработке макроса.

Есть файл, суть принципа такова:
На листе Затраты в столбик H вручную проставляются номера примечаний 1, 2, 3, 4, 5.....
Документ лежит в одной папке с картинками формата jpg, которые подписываются также - 1, 2, 3, 4....

После нажатия на кнопку Загрузка скан-копий происходит создание листов согласно проставленных номерков в столбике H и на эти листы вставляются одноименные картинки... Всё вроде отлично работало, но есть две проблемы:

1. Картинки вставляются не как объекты, а как ссылки и при удалении картинки с папки или пересылки документа в другое место понятное дело получаем "Изображение не найдено"..., хотелось бы чтоб картинки вставлялись именно как отдельный независимый объект и тут же одно небольшое примечание, у меня в коде прописана поиск и вставка из папки картинок jpg, можете подправить так что искало и вставляло графические объекты из текущей папки независимо от формата.

2. А вторая проблема в том, что при большом количестве примечаний(картинок) около 20-ти не создаются все листы, почему-то пропускает создание части листов...

Прошу тех кто гуру в макросах, помочь оптимизировать данный макрос.

Файл в приложении...
Изменено: marker_mc - 05.02.2013 12:18:30
 
Попробуйте вставлять картинки таким кодом:
Код
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 - 05.02.2013 12:43:24
 
Цитата
EducatedFool пишет:
Dim sha As Shape
Set sha = ActiveSheet.Shapes.AddPicture(ПутьКФайлу$, msoFalse, msoCTrue, -1, -1, -1, -1)

Да, это оно, теперь картинки именно влаживаются в файл. Только подскажите где тут указать чтоб влаживалось в ячейку b1, а не в а1. и тогда первый пункт моей проблемы полностью будет решен))))

Насчет вашей надстройки, я давно её видел и пробовал тестировать, у меня немножко другая цель преследуется и надстройка немного для меня не актуальна, а так считаю весьма полезная штука

Цитата
т.к. протестировать ваш макрос без нужных картинок проблематично.

тут все просто, любых 20 картинок формата jpeg, можно даже одну и ту же скопировать 20 раз и переименовать порядковыми номерами, а потому в столбец H проставить эти номер в разброс чтоб они не подряд шли.
Изменено: marker_mc - 05.02.2013 13:19:00
 
Цитата
marker_mc пишет:
...влаживаются в файл. ... чтоб влаживалось
И где Вы такие слова берёте?  :)
Вкладывать.
 
Юрий, это всё наш суржик хохляций виноват)))))
 
Цитата
Только подскажите где тут указать чтоб влаживалось в ячейку b1, а не в а1
Это уже просто.
После вставки картинки, измените её свойства Left и Top:
Код
sha.left = [b1].left
sha.top = [b1].top
 
я пока писал то что разобрался с этим, вы дали ответ быстрее)))) правда я сделал по другому, я вместо первого значения "-1" поставил значение 50 и картинка начала попадать в b1
я вот пытаюсь добиться чтоб понимало не только .jpg но и любые другие форматы картинки, нужно что то сделать с этой строкой:

Код
primer = ThisWorkbook.Path & "\" & nmr & ".jpg"


а вот что?

как указать последний аргумент не jpg, а "любой графический файл"?

и по прежнему ищу причину, почему не создаются все необходимые листы.
Изменено: marker_mc - 05.02.2013 14:14:38
 
как указать "любой графический объект" я не понял пока что, а вот с той проблемой, что не создаются все листы на которые есть картинки, увидел закономерность...
если в столбик 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


Может подскажет кто в чем дело?
Изменено: marker_mc - 05.02.2013 15:47:44
 
Ребята, вопрос очень горящий.... смилуйтесь)))) помогите исправить код чтоб листы все создавало.
 
а файл какой?
Киса, я хочу Вас спросить, как художник — художника: Вы рисовать умеете?
Страницы: 1
Читают тему
Наверх