Гость
Целевая тема:
Создать новую тему:
Автор:
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки. / 7 сообщений из 7, страница 1 из 1
21.04.2010, 13:28
    #36590007
creyn
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
Приветствую всех!
Год назад програмировал в байзике последний раз, а до этого последний раз был года за два. Вобщем позабыл многое, прошу вашей помощи.

Что есть сейчас:
авторSub m()


ActiveSheet.PasteSpecial Format:="Рисунок", Link:=False, DisplayAsIcon:= _
False
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 140
Selection.ShapeRange.Width = 210
End Sub

что хочу получить:
автор
Set fs = Application.FileSearch
With fs
.LookIn = Range("E2")
.Filename = textNamefile
.SearchSubFolders = True


If .Execute > 0 Then

For j = 1 To .FoundFiles.Count

ActiveSheet.Pictures.Insert(.FoundFiles(1)).Select

Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 140
Selection.ShapeRange.Width = 210

Next j
знаю что Application.FileSearch не работает в офисе 2007, нашёл вот это, но никак не могу объединить ((
авторSub SelectFolder2SearchFiles()

Dim fileToOpen As String
Dim dirPath As String

fileToOpen = Application _
.GetOpenFilename()
If fileToOpen <> "" Then
MsgBox "Open " & fileToOpen
End If

dirPath = Left(fileToOpen, InStrRev(fileToOpen, "\"))

MsgBox "Путь к выбранному файлу " & dirPath
End Sub
Т.е. хочу чтобы макрос работал таким образом: я выбираю папку с фотками, макрос все фотки которые есть в папке берёт и ставит в ячейки по возрастанию в одной колонке (желательно с выбором колонки) с нужными параметрами форматирования.
Помогите собрать в кучу...а то как то неполучается ничего. С меня пиво ;)
...
Рейтинг: 0 / 0
21.04.2010, 13:37
    #36590041
creyn
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
creyn,

вот нашёл ещё что-то похожее...но пишут что в 2007 работает не корректно, пока пытаюсь запустить (файлы почемуто вообще не вставляет)

авторSub Vstavka_Kartinok()
Sheets("Лист2").Select
x = 1
Range("A1").Select
While Sheets("Лист2").Cells(x, 2).Text <> ""
x = x + 1
Wend
x = x - 1
For i = 2 To x
kartinka = Sheets("Лист2").Cells(i, 2).Value
Range("E" & CStr(i)).Select
ActiveSheet.Pictures.Insert("C:\Documents and Settings\Àäìèí\Ðàáî÷èé ñòîë\TUB 221" & CStr(kartinka) & ".bmp").Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height = 152.2
Selection.ShapeRange.Width = 183.75
Selection.ShapeRange.Rotation = 0#
Selection.ShapeRange.ScaleHeight 0.8, msoFalse, msoScaleFromTopLeft
Next i
MsgBox ("Фото вставлены")
End Sub
...
Рейтинг: 0 / 0
22.04.2010, 10:11
    #36591667
creyn
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
creyn,

никто не может помочь?
последний скрипт не могу запустить, гдето ошибка, пишет файлы вставлены, а на самом деле ничего нет.

Кстати пользуюсь беткой 2010 офиса, думаю ещё из-за этого есть проблемы в работе.
...
Рейтинг: 0 / 0
23.04.2010, 16:15
    #36595239
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
creyncreyn,
пишет файлы вставлены, а на самом деле ничего нет.
А у вас на листе "Лист2" в ячейке B2 есть название картинки?

Сообщение "Фото вставлены" судя по коду пишет в любом случае.
...
Рейтинг: 0 / 0
23.04.2010, 16:22
    #36595268
Djon Player
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
Случайно сообщение раньше времени отправилось, да ещё с опечатками.

Так вот как минимум ячейки B1 и B2 должны быть не пустыми, иначе цикл даже не выполняется, т.к. на тот момент значение x либо 0, либо 1.
Причем ячейка B3 на листе "Лист2" должна содержать имя файла картинки, без указания пути к папке и расширения.
Если всё это соблюсти, то всё вставляется, я проверил.
...
Рейтинг: 0 / 0
04.05.2010, 13:54
    #36610956
creyn
Гость
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
спасибо за ответ!

действительно, сейчас прочитал ваше ссобщение, сравнил с кодом увидел эту проблему.
такой вопрос: как сделать так, чтобы скрипт работал автоматически? иначе теряется смысл если надо вставлять названия файлов.
хотябы чтобы нужно было только указать папку из которой брать и стартовую ячейку для певой фотографии. буду очень рад помощи.
...
Рейтинг: 0 / 0
04.05.2010, 15:02
    #36611105
Сергей06
Участник
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки.
Код: plaintext
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
'Этот код работает в Винде 2000 и в Висте (в ХР проблемы с кодировкой кирилицы первой папки на сетевом ресурсе)
Private Sub Запуск_Выбора_катологов_подкаталогов()
Dim fso As New FileSystemObject
     
  ВыбратьКаталогПодкаталогиFSO fso.GetFolder("C:\Documents and Settings\v6448\Мои документы\Мои рисунки") ' Каталог где обрабатываем ВСЕ файлы "XLS"
   
End Sub

'FileSystemObject - БИБЛИОТЕКА  Microsoft Scripting Runtime
Sub ВыбратьКаталогПодкаталогиFSO(Папка As Folder)
Dim fso As New FileSystemObject, fold As Folder, iFile As File
Set ifold = fso.GetFolder(Папка)

 For Each fold In Папка.SubFolders
   ВыбратьКаталогПодкаталогиFSO fold        'лезем в рекурсию
 
 Next
  
 For Each iFile In Папка.Files
   If UCase(Right(iFile,  3 )) = "JPG" Then ' Проверка что это "JPG" файл
     'MsgBox iFile

ActiveSheet.Pictures.Insert(iFile).Select
Selection.ShapeRange.LockAspectRatio = msoFalse
Selection.ShapeRange.Height =  152 . 2 
Selection.ShapeRange.Width =  183 . 75 
Selection.ShapeRange.Rotation =  0 #
Selection.ShapeRange.ScaleHeight  0 . 8 , msoFalse, msoScaleFromTopLeft

   End If
 Next

End Sub
...
Рейтинг: 0 / 0
Форумы / Microsoft Office [игнор отключен] [закрыт для гостей] / Выбор папки для поиска картинок и последующая вставка этих картинок в ячейки. / 7 сообщений из 7, страница 1 из 1
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]