Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Microsoft Office и VBA программирование > Microsoft Office Word
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 13.02.2014, 21:46   #1
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию Импорт картинок из папки в текст WORD 2007 макросом

Здравствуйте, форумчане!!!
Мне надо импортировать все картинки из папки в текст WORD 2007 используя макрос.
Начинаю запись макроса, из *Вставка* выбираю *Вставить рисунок из файла*, указываю папку где лежат .bmp , нажимаю Ctrl+A, Enter и ...
останавливаю запись макроса. А когда хочу воспользоваться этим макросом, то получаю только одну картинку.

Selection.InlineShapes.AddPicture Filename:= _
"C:\Documents and Settings\All Users\Documents\shared Mcamx6\common\reports\IMG\Image #1.bmp" _
, LinkToFile:=False, SaveWithDocument:=True

Подскажите , как заставить импортироваться ВСЕ картинки из папки???

Последний раз редактировалось hlibhlib; 13.02.2014 в 21:56.
hlibhlib вне форума Ответить с цитированием
Старый 14.02.2014, 07:33   #2
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Каким образом вставлять? Все подряд друг за другом?
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума Ответить с цитированием
Старый 14.02.2014, 18:33   #3
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию

Цитата:
Сообщение от viter.alex Посмотреть сообщение
Каким образом вставлять? Все подряд друг за другом?
Здравствуйте, viter.alex.
Картинки находящиеся в папке, имеют названия с номерами очередности их создания.
Расположение их должно быть поочередно сверху вниз по документу и уменьшены в 2-а раза сохраняя пропорцию.

Спасибо за отклик и старание помочь.

Выбираю стандартную функцию - *Вставить рисунок из файла*, потом макросом, кот. нарыл и-нэте, (спасибо выложившему):

Attribute VB_Name = "Module3"
Sub changeImages2()
Dim pic As Object
On Error Resume Next
For Each pic In ActiveDocument.Content.InlineShapes
If pic.Type = wdInlineShapePicture Then
pic.Height = pic.Height / 2
pic.Width = pic.Width / 2
End If
Next
For Each pic In ActiveDocument.Content.ShapeRange
If pic.Type = msoPicture Then
pic.Height = pic.Height / 2
If pic.LockAspectRatio = msoFalse Then
pic.Width = pic.Width / 2
End If
End If
Next
End Sub

Пробовал команды и строки из учебников тыкать, но о результате можно догадаться! Темный лес - да и только!
Изображения
Тип файла: jpg место.JPG (102.1 Кб, 148 просмотров)

Последний раз редактировалось hlibhlib; 14.02.2014 в 22:40.
hlibhlib вне форума Ответить с цитированием
Старый 15.02.2014, 05:07   #4
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Порядок сортировки зависит от порядка сортировке в окне выбора файлов
Код:
Sub InsertPicturesFromFolder()
    'Диалог выбора файлов
    With Application.FileDialog(msoFileDialogFilePicker)
        .AllowMultiSelect = True
        .Title = "Выберите изображения"
        .Filters.Clear
        .Filters.Add "Изображения JPEG", "*.jpeg;*.jpg"
        .Filters.Add "Изображения PNG", "*.png"
        .Filters.Add "Изображения BMP", "*.bmp"
        .Filters.Add "Все изображения", "*.jpeg;*.jpg;*.png;*.bmp"
        .InitialView = msoFileDialogViewProperties
        If .Show Then
            Dim inshp As InlineShape, i As Integer
            For i = 1 To .SelectedItems.Count
                'Вставка изображения
                Set inshp = ActiveDocument.Paragraphs.Last.Range.InlineShapes.AddPicture(.SelectedItems(i), False, True)
                'Фиксация соотношения сторон
                inshp.LockAspectRatio = msoTrue
                'Уменьшаем ширину в два раза (на 50%)
                inshp.ScaleWidth = 50
                'Добавляем ещё один абзац
                ActiveDocument.Paragraphs.Last.Range.InsertParagraphAfter
            Next
        Else
            Exit Sub
        End If
    End With
End Sub
Лучше день потерять — потом за пять минут долететь!©

Последний раз редактировалось viter.alex; 15.02.2014 в 05:10.
viter.alex вне форума Ответить с цитированием
Старый 15.02.2014, 13:23   #5
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию

Спасибо.
Подумаю, что можно с этим кодом сделать.
Спасибо.
hlibhlib вне форума Ответить с цитированием
Старый 17.02.2014, 23:36   #6
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию

Нет, не получается.

Очень жаль.
hlibhlib вне форума Ответить с цитированием
Старый 18.02.2014, 02:09   #7
viter.alex
Балуюсь кодами
Участник клуба
 
Аватар для viter.alex
 
Регистрация: 09.01.2009
Сообщений: 1,837
По умолчанию

Что не получается? Не говорите загадками
Лучше день потерять — потом за пять минут долететь!©
viter.alex вне форума Ответить с цитированием
Старый 18.02.2014, 19:16   #8
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию

CUT; CUT; CUT;

Последний раз редактировалось hlibhlib; 18.02.2014 в 19:55.
hlibhlib вне форума Ответить с цитированием
Старый 18.02.2014, 19:54   #9
hlibhlib
 
Регистрация: 13.02.2014
Сообщений: 6
По умолчанию

Цитата:
Сообщение от viter.alex Посмотреть сообщение
Что не получается? Не говорите загадками
Челобитная в личке.
hlibhlib вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Импорт нескольких txt файлов макросом Snekich Microsoft Office Excel 25 06.03.2013 15:42
Как открыть шаблон Word-a из папки в корневой папки программы :) flouwjke Общие вопросы Delphi 3 30.04.2012 00:25
Импорт данных из Word в Excel макросом vv66 Microsoft Office Excel 17 27.01.2012 14:49
Просмотр картинок из папки Elementery Общие вопросы Delphi 5 25.05.2010 17:06
загрузка картинок из папки firmwares Мультимедиа в Delphi 7 28.01.2010 01:13