Вопрос к знатокам Excel и макросов.

Поделиться12008-01-14 18:33:08

Автор: Klepa
Маршал форума
Откуда: Saint-Peterburg
Зарегистрирован: 2007-03-21
Приглашений: 0
Сообщений: 510
Уважение: +20
Позитив: +5
Пол: Мужской
Возраст: 42 [1982-07-11]
Провел на форуме:
4 дня 6 часов
Последний визит:
2008-05-12 12:13:00

У меня есть .xls файл на 4500 строк и 4500 картинок в форматах .jpg и .gif.
Вопрос: как при помощи макроса эти картинки можно вписать в экселевский файлик, дабы ручками не мучаться?
У меня есть пример макроса, но я не совсем понимаю как это работает:

Код:

Sub Макрос1()

For Counter = 2 To 5000
Set curCell = ActiveSheet.Cells(Counter, 9)
 Set curPath = ActiveSheet.Cells(Counter, 8)
 curCell.Select
 ActiveSheet.Pictures.Insert(curPath.Value).Select
 Selection.ShapeRange.Height = 80#
 Selection.ShapeRange.Width = 80#
Next Counter
 
End Sub

Кто может объяснить как это работает? Особенно интересуют строчки:

Код:

....
 Set curPath = ActiveSheet.Cells(Counter, 8)
....
 ActiveSheet.Pictures.Insert(curPath.Value).Select
....

Насколько понимаю, первая задает путь до картинки, а вторая загружает её. Но как-то странно это все задается.... :blink:

0

Поделиться22008-01-14 23:17:49

Автор: jurka4
Соклановец
Зарегистрирован: 2007-10-29
Приглашений: 0
Сообщений: 194
Уважение: +8
Позитив: +22
Пол: Мужской
Возраст: 40 [1984-03-23]
Провел на форуме:
1 день 8 часов
Последний визит:
2010-10-03 21:00:27

ну ты и спросил,

0

Поделиться32008-01-15 10:41:01

Автор: Klepa
Маршал форума
Откуда: Saint-Peterburg
Зарегистрирован: 2007-03-21
Приглашений: 0
Сообщений: 510
Уважение: +20
Позитив: +5
Пол: Мужской
Возраст: 42 [1982-07-11]
Провел на форуме:
4 дня 6 часов
Последний визит:
2008-05-12 12:13:00

Неужели тут только знатоки раппелза есть?

0

Поделиться42008-01-15 11:16:32

Автор: Тень
Повелительница Пикси
Зарегистрирован: 2007-07-31
Приглашений: 0
Сообщений: 769
Уважение: +39
Позитив: +38
Пол: Женский
Возраст: 44 [1980-09-11]
Провел на форуме:
6 дней 19 часов
Последний визит:
2009-01-10 22:32:14

э.... хм... я попробую у ребят спросить...

0

Поделиться52008-01-15 12:10:41

Автор: Klepa
Маршал форума
Откуда: Saint-Peterburg
Зарегистрирован: 2007-03-21
Приглашений: 0
Сообщений: 510
Уважение: +20
Позитив: +5
Пол: Мужской
Возраст: 42 [1982-07-11]
Провел на форуме:
4 дня 6 часов
Последний визит:
2008-05-12 12:13:00

Спасибо. Мне уже автор этого чуда объяснил что к чему.

0

Поделиться62008-01-15 12:19:23

Автор: jurka4
Соклановец
Зарегистрирован: 2007-10-29
Приглашений: 0
Сообщений: 194
Уважение: +8
Позитив: +22
Пол: Мужской
Возраст: 40 [1984-03-23]
Провел на форуме:
1 день 8 часов
Последний визит:
2010-10-03 21:00:27

а то этот макрос делает?для чего он?

0

Поделиться72008-01-15 15:08:16

Автор: Klepa
Маршал форума
Откуда: Saint-Peterburg
Зарегистрирован: 2007-03-21
Приглашений: 0
Сообщений: 510
Уважение: +20
Позитив: +5
Пол: Мужской
Возраст: 42 [1982-07-11]
Провел на форуме:
4 дня 6 часов
Последний визит:
2008-05-12 12:13:00

Берет путь до картинки из одной ячейки и вставляет эту картинку в другую ячейку. Потом изменяет размеры этой картинки.

0

Поделиться82008-01-15 18:07:36

Автор: Тень
Повелительница Пикси
Зарегистрирован: 2007-07-31
Приглашений: 0
Сообщений: 769
Уважение: +39
Позитив: +38
Пол: Женский
Возраст: 44 [1980-09-11]
Провел на форуме:
6 дней 19 часов
Последний визит:
2009-01-10 22:32:14

Мне тут еще ответ дали, может понадобится:

Насколько я понимаю, на текущей страничке в одном столбце есть список путей к рисункам, а права от этого столбца они вставляются этим макросом)

Тебе, как я понимаю, надо сделать перебор файлов. Например, через FileScriptingObject, это у тебя будет путь, а дальше уже insert

Код:

 
Function ShowFolderList(folder)
   Dim fso, f, f1, fc, s
   Set fso = CreateObject("Scripting.FileSystemObject")
   Set f = fso.GetFolder(folder)
   Set fc = f.Files
   Counter = 1
   For Each f1 In fc
     Set CurCell = ActiveSheet.Cells(Counter, 1)
     CurCell.Select
     Path = folder & f1.Name
     ActiveSheet.Pictures.Insert(Path). _
        Select
     s = s & folder & f1.Name & vbCrLf
     Counter = Counter + 1
   Next
   ShowFolderList = s
End Function

Sub Main()
   Reestr = ShowFolderList("С:\ТвояПапкаСКартинками\")
   ActiveSheet.Cells(1, 2).Value = Reestr
End Sub